/-
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

end Mathlib


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.finset.lattice

/-!
# The powerset of a finset
-/

namespace finset
open multiset

variables {α : Type*}

/-! ### powerset -/
section powerset

/-- When `s` is a finset, `s.powerset` is the finset of all subsets of `s` (seen as finsets). -/
def powerset (s : finset α) : finset (finset α) :=
⟨s.1.powerset.pmap finset.mk $ λ t h, nodup_of_le (mem_powerset.1 h) s.nodup,
 s.nodup.powerset.pmap $ λ a ha b hb, congr_arg finset.val⟩

@[simp] theorem mem_powerset {s t : finset α} : s ∈ powerset t ↔ s ⊆ t :=
by cases s; simp only [powerset, mem_mk, mem_pmap, mem_powerset, exists_prop, exists_eq_right];
  rw ← val_le_iff

@[simp] theorem empty_mem_powerset (s : finset α) : ∅ ∈ powerset s :=
mem_powerset.2 (empty_subset _)

@[simp] theorem mem_powerset_self (s : finset α) : s ∈ powerset s :=
mem_powerset.2 (subset.refl _)

@[simp] lemma powerset_empty : finset.powerset (∅ : finset α) = {∅} := rfl

@[simp] theorem powerset_mono {s t : finset α} : powerset s ⊆ powerset t ↔ s ⊆ t :=
⟨λ h, (mem_powerset.1 $ h $ mem_powerset_self _),
 λ st u h, mem_powerset.2 $ subset.trans (mem_powerset.1 h) st⟩

/-- **Number of Subsets of a Set** -/
@[simp] theorem card_powerset (s : finset α) :
  card (powerset s) = 2 ^ card s :=
(card_pmap _ _ _).trans (card_powerset s.1)

lemma not_mem_of_mem_powerset_of_not_mem {s t : finset α} {a : α}
  (ht : t ∈ s.powerset) (h : a ∉ s) : a ∉ t :=
by { apply mt _ h, apply mem_powerset.1 ht }

lemma powerset_insert [decidable_eq α] (s : finset α) (a : α) :
  powerset (insert a s) = s.powerset ∪ s.powerset.image (insert a) :=
begin
  ext t,
  simp only [exists_prop, mem_powerset, mem_image, mem_union, subset_insert_iff],
  by_cases h : a ∈ t,
  { split,
    { exact λH, or.inr ⟨_, H, insert_erase h⟩ },
    { intros H,
      cases H,
      { exact subset.trans (erase_subset a t) H },
      { rcases H with ⟨u, hu⟩,
        rw ← hu.2,
        exact subset.trans (erase_insert_subset a u) hu.1 } } },
  { have : ¬ ∃ (u : finset α), u ⊆ s ∧ insert a u = t,
      by simp [ne.symm (ne_insert_of_not_mem _ _ h)],
    simp [finset.erase_eq_of_not_mem h, this] }
end

/-- For predicate `p` decidable on subsets, it is decidable whether `p` holds for any subset. -/
instance decidable_exists_of_decidable_subsets {s : finset α} {p : Π t ⊆ s, Prop}
  [Π t (h : t ⊆ s), decidable (p t h)] : decidable (∃ t (h : t ⊆ s), p t h) :=
decidable_of_iff (∃ t (hs : t ∈ s.powerset), p t (mem_powerset.1 hs))
⟨(λ ⟨t, _, hp⟩, ⟨t, _, hp⟩), (λ ⟨t, hs, hp⟩, ⟨t, mem_powerset.2 hs, hp⟩)⟩

/-- For predicate `p` decidable on subsets, it is decidable whether `p` holds for every subset. -/
instance decidable_forall_of_decidable_subsets {s : finset α} {p : Π t ⊆ s, Prop}
  [Π t (h : t ⊆ s), decidable (p t h)] : decidable (∀ t (h : t ⊆ s), p t h) :=
decidable_of_iff (∀ t (h : t ∈ s.powerset), p t (mem_powerset.1 h))
⟨(λ h t hs, h t (mem_powerset.2 hs)), (λ h _ _, h _ _)⟩

/-- A version of `finset.decidable_exists_of_decidable_subsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_exists_of_decidable_subsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊆ s), decidable (p t)) : decidable (∃ t (h : t ⊆ s), p t) :=
@finset.decidable_exists_of_decidable_subsets _ _ _ hu

/-- A version of `finset.decidable_forall_of_decidable_subsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_forall_of_decidable_subsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊆ s), decidable (p t)) : decidable (∀ t (h : t ⊆ s), p t) :=
@finset.decidable_forall_of_decidable_subsets _ _ _ hu

end powerset

section ssubsets
variables [decidable_eq α]

/-- For `s` a finset, `s.ssubsets` is the finset comprising strict subsets of `s`. -/
def ssubsets (s : finset α) : finset (finset α) :=
erase (powerset s) s

@[simp] lemma mem_ssubsets {s t : finset α} : t ∈ s.ssubsets ↔ t ⊂ s :=
by rw [ssubsets, mem_erase, mem_powerset, ssubset_iff_subset_ne, and.comm]

lemma empty_mem_ssubsets {s : finset α} (h : s.nonempty) : ∅ ∈ s.ssubsets :=
by { rw [mem_ssubsets, ssubset_iff_subset_ne], exact ⟨empty_subset s, h.ne_empty.symm⟩, }

/-- For predicate `p` decidable on ssubsets, it is decidable whether `p` holds for any ssubset. -/
instance decidable_exists_of_decidable_ssubsets {s : finset α} {p : Π t ⊂ s, Prop}
  [Π t (h : t ⊂ s), decidable (p t h)] : decidable (∃ t h, p t h) :=
decidable_of_iff (∃ t (hs : t ∈ s.ssubsets), p t (mem_ssubsets.1 hs))
⟨(λ ⟨t, _, hp⟩, ⟨t, _, hp⟩), (λ ⟨t, hs, hp⟩, ⟨t, mem_ssubsets.2 hs, hp⟩)⟩

/-- For predicate `p` decidable on ssubsets, it is decidable whether `p` holds for every ssubset. -/
instance decidable_forall_of_decidable_ssubsets {s : finset α} {p : Π t ⊂ s, Prop}
  [Π t (h : t ⊂ s), decidable (p t h)] : decidable (∀ t h, p t h) :=
decidable_of_iff (∀ t (h : t ∈ s.ssubsets), p t (mem_ssubsets.1 h))
⟨(λ h t hs, h t (mem_ssubsets.2 hs)), (λ h _ _, h _ _)⟩

/-- A version of `finset.decidable_exists_of_decidable_ssubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_exists_of_decidable_ssubsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊂ s), decidable (p t)) : decidable (∃ t (h : t ⊂ s), p t) :=
@finset.decidable_exists_of_decidable_ssubsets _ _ _ _ hu

/-- A version of `finset.decidable_forall_of_decidable_ssubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_forall_of_decidable_ssubsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊂ s), decidable (p t)) : decidable (∀ t (h : t ⊂ s), p t) :=
@finset.decidable_forall_of_decidable_ssubsets _ _ _ _ hu

end ssubsets

section powerset_len

/-- Given an integer `n` and a finset `s`, then `powerset_len n s` is the finset of subsets of `s`
of cardinality `n`. -/
def powerset_len (n : ℕ) (s : finset α) : finset (finset α) :=
⟨(s.1.powerset_len n).pmap finset.mk $ λ t h, nodup_of_le (mem_powerset_len.1 h).1 s.2,
 s.2.powerset_len.pmap $ λ a ha b hb, congr_arg finset.val⟩

/-- **Formula for the Number of Combinations** -/
theorem mem_powerset_len {n} {s t : finset α} :
  s ∈ powerset_len n t ↔ s ⊆ t ∧ card s = n :=
by cases s; simp [powerset_len, val_le_iff.symm]; refl

@[simp] theorem powerset_len_mono {n} {s t : finset α} (h : s ⊆ t) :
  powerset_len n s ⊆ powerset_len n t :=
λ u h', mem_powerset_len.2 $
  and.imp (λ h₂, subset.trans h₂ h) id (mem_powerset_len.1 h')

/-- **Formula for the Number of Combinations** -/
@[simp] theorem card_powerset_len (n : ℕ) (s : finset α) :
  card (powerset_len n s) = nat.choose (card s) n :=
(card_pmap _ _ _).trans (card_powerset_len n s.1)

@[simp] lemma powerset_len_zero (s : finset α) : finset.powerset_len 0 s = {∅} :=
begin
  ext, rw [mem_powerset_len, mem_singleton, card_eq_zero],
  refine ⟨λ h, h.2, λ h, by { rw h, exact ⟨empty_subset s, rfl⟩ }⟩,
end

@[simp] theorem powerset_len_empty (n : ℕ) {s : finset α} (h : s.card < n) :
  powerset_len n s = ∅ :=
finset.card_eq_zero.mp (by rw [card_powerset_len, nat.choose_eq_zero_of_lt h])

theorem powerset_len_eq_filter {n} {s : finset α} :
  powerset_len n s = (powerset s).filter (λ x, x.card = n) :=
by { ext, simp [mem_powerset_len] }

lemma powerset_len_succ_insert [decidable_eq α] {x : α} {s : finset α} (h : x ∉ s) (n : ℕ) :
  powerset_len n.succ (insert x s) = powerset_len n.succ s ∪ (powerset_len n s).image (insert x) :=
begin
  rw [powerset_len_eq_filter, powerset_insert, filter_union, ←powerset_len_eq_filter],
  congr,
  rw [powerset_len_eq_filter, image_filter],
  congr' 1,
  ext t,
  simp only [mem_powerset, mem_filter, function.comp_app, and.congr_right_iff],
  intro ht,
  have : x ∉ t := λ H, h (ht H),
  simp [card_insert_of_not_mem this, nat.succ_inj']
end

lemma powerset_len_nonempty {n : ℕ} {s : finset α} (h : n < s.card) :
  (powerset_len n s).nonempty :=
begin
  classical,
  induction s using finset.induction_on with x s hx IH generalizing n,
  { simpa using h },
  { cases n,
    { simp },
    { rw [card_insert_of_not_mem hx, nat.succ_lt_succ_iff] at h,
      rw powerset_len_succ_insert hx,
      refine nonempty.mono _ ((IH h).image (insert x)),
      convert (subset_union_right _ _) } }
end

@[simp] lemma powerset_len_self (s : finset α) :
  powerset_len s.card s = {s} :=
begin
  ext,
  rw [mem_powerset_len, mem_singleton],
  split,
  { exact λ ⟨hs, hc⟩, eq_of_subset_of_card_le hs hc.ge },
  { rintro rfl,
    simp }
end

lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) :
  finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) :=
begin
  refine ext (λ a, ⟨λ ha, _, λ ha, _ ⟩),
  { rw mem_bUnion,
    exact ⟨a.card, mem_range.mpr (nat.lt_succ_of_le (card_le_of_subset (mem_powerset.mp ha))),
      mem_powerset_len.mpr ⟨mem_powerset.mp ha, rfl⟩⟩ },
  { rcases mem_bUnion.mp ha with ⟨i, hi, ha⟩,
    exact mem_powerset.mpr (mem_powerset_len.mp ha).1, }
end

lemma powerset_len_sup [decidable_eq α] (u : finset α) (n : ℕ) (hn : n < u.card) :
  (powerset_len n.succ u).sup id = u :=
begin
  apply le_antisymm,
  { simp_rw [sup_le_iff, mem_powerset_len],
    rintros x ⟨h, -⟩,
    exact h },
  { rw [sup_eq_bUnion, le_iff_subset, subset_iff],
    cases (nat.succ_le_of_lt hn).eq_or_lt with h' h',
    { simp [h'] },
    { intros x hx,
      simp only [mem_bUnion, exists_prop, id.def],
      obtain ⟨t, ht⟩ : ∃ t, t ∈ powerset_len n (u.erase x) := powerset_len_nonempty _,
      { refine ⟨insert x t, _, mem_insert_self _ _⟩,
        rw [←insert_erase hx, powerset_len_succ_insert (not_mem_erase _ _)],
        exact mem_union_right _ (mem_image_of_mem _ ht) },
      { rwa [card_erase_of_mem hx, lt_tsub_iff_right] } } }
end

@[simp]
lemma powerset_len_card_add (s : finset α) {i : ℕ} (hi : 0 < i) :
  s.powerset_len (s.card + i) = ∅ :=
finset.powerset_len_empty _ (lt_add_of_pos_right (finset.card s) hi)

@[simp] theorem map_val_val_powerset_len (s : finset α) (i : ℕ) :
  (s.powerset_len i).val.map finset.val = s.1.powerset_len i :=
by simp [finset.powerset_len, map_pmap, pmap_eq_map, map_id']

end powerset_len
end finset


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module measure_theory.measure.haar_of_basis
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.Haar
import Mathbin.Analysis.InnerProductSpace.PiL2

/-!
# Additive Haar measure constructed from a basis

Given a basis of a finite-dimensional real vector space, we define the corresponding Lebesgue
measure, which gives measure `1` to the parallelepiped spanned by the basis.

## Main definitions

* `parallelepiped v` is the parallelepiped spanned by a finite family of vectors.
* `basis.parallelepiped` is the parallelepiped associated to a basis, seen as a compact set with
nonempty interior.
* `basis.add_haar` is the Lebesgue measure associated to a basis, giving measure `1` to the
corresponding parallelepiped.

In particular, we declare a `measure_space` instance on any finite-dimensional inner product space,
by using the Lebesgue measure associated to some orthonormal basis (which is in fact independent
of the basis).
-/

open Set TopologicalSpace MeasureTheory MeasureTheory.Measure FiniteDimensional

open BigOperators

noncomputable section

variable {ι ι' E F : Type _} [Fintype ι] [Fintype ι']

section AddCommGroup

variable [AddCommGroup E] [Module ℝ E] [AddCommGroup F] [Module ℝ F]

/-- The closed parallelepiped spanned by a finite family of vectors. -/
def parallelepiped (v : ι → E) : Set E :=
  (fun t : ι → ℝ => ∑ i, t i • v i) '' Icc 0 1
#align parallelepiped parallelepiped

theorem mem_parallelepiped_iff (v : ι → E) (x : E) :
    x ∈ parallelepiped v ↔ ∃ (t : ι → ℝ)(ht : t ∈ Icc (0 : ι → ℝ) 1), x = ∑ i, t i • v i := by
  simp [parallelepiped, eq_comm]
#align mem_parallelepiped_iff mem_parallelepiped_iff

theorem image_parallelepiped (f : E →ₗ[ℝ] F) (v : ι → E) :
    f '' parallelepiped v = parallelepiped (f ∘ v) :=
  by
  simp only [parallelepiped, ← image_comp]
  congr 1 with t
  simp only [Function.comp_apply, LinearMap.map_sum, LinearMap.map_smulₛₗ, RingHom.id_apply]
#align image_parallelepiped image_parallelepiped

/-- Reindexing a family of vectors does not change their parallelepiped. -/
@[simp]
theorem parallelepiped_comp_equiv (v : ι → E) (e : ι' ≃ ι) :
    parallelepiped (v ∘ e) = parallelepiped v :=
  by
  simp only [parallelepiped]
  let K : (ι' → ℝ) ≃ (ι → ℝ) := Equiv.piCongrLeft' (fun a : ι' => ℝ) e
  have : Icc (0 : ι → ℝ) 1 = K '' Icc (0 : ι' → ℝ) 1 :=
    by
    rw [← Equiv.preimage_eq_iff_eq_image]
    ext x
    simp only [mem_preimage, mem_Icc, Pi.le_def, Pi.zero_apply, Equiv.piCongrLeft'_apply,
      Pi.one_apply]
    refine'
      ⟨fun h => ⟨fun i => _, fun i => _⟩, fun h =>
        ⟨fun i => h.1 (e.symm i), fun i => h.2 (e.symm i)⟩⟩
    · simpa only [Equiv.symm_apply_apply] using h.1 (e i)
    · simpa only [Equiv.symm_apply_apply] using h.2 (e i)
  rw [this, ← image_comp]
  congr 1 with x
  simpa only [OrthonormalBasis.coe_reindex, Function.comp_apply, Equiv.symm_apply_apply,
    Equiv.piCongrLeft'_apply, Equiv.apply_symm_apply] using
    (e.symm.sum_comp fun i : ι' => x i • v (e i)).symm
#align parallelepiped_comp_equiv parallelepiped_comp_equiv

-- The parallelepiped associated to an orthonormal basis of `ℝ` is either `[0, 1]` or `[-1, 0]`.
theorem parallelepiped_orthonormalBasis_one_dim (b : OrthonormalBasis ι ℝ ℝ) :
    parallelepiped b = Icc 0 1 ∨ parallelepiped b = Icc (-1) 0 :=
  by
  have e : ι ≃ Fin 1 := by
    apply Fintype.equivFinOfCardEq
    simp only [← finrank_eq_card_basis b.to_basis, finrank_self]
  have B : parallelepiped (b.reindex e) = parallelepiped b :=
    by
    convert parallelepiped_comp_equiv b e.symm
    ext i
    simp only [OrthonormalBasis.coe_reindex]
  rw [← B]
  let F : ℝ → Fin 1 → ℝ := fun t => fun i => t
  have A : Icc (0 : Fin 1 → ℝ) 1 = F '' Icc (0 : ℝ) 1 :=
    by
    apply subset.antisymm
    · intro x hx
      refine' ⟨x 0, ⟨hx.1 0, hx.2 0⟩, _⟩
      ext j
      simp only [Subsingleton.elim j 0]
    · rintro x ⟨y, hy, rfl⟩
      exact ⟨fun j => hy.1, fun j => hy.2⟩
  rcases orthonormalBasis_one_dim (b.reindex e) with (H | H)
  · left
    simp only [H, parallelepiped, Algebra.id.smul_eq_mul, mul_one, A, Finset.sum_singleton, ←
      image_comp, image_id', Finset.univ_unique]
  · right
    simp only [H, parallelepiped, Algebra.id.smul_eq_mul, mul_one]
    rw [A]
    simp only [← image_comp, mul_neg, mul_one, Finset.sum_singleton, image_neg, preimage_neg_Icc,
      neg_zero, Finset.univ_unique]
#align parallelepiped_orthonormal_basis_one_dim parallelepiped_orthonormalBasis_one_dim

end AddCommGroup

section NormedSpace

variable [NormedAddCommGroup E] [NormedSpace ℝ E]

/-- The parallelepiped spanned by a basis, as a compact set with nonempty interior. -/
def Basis.parallelepiped (b : Basis ι ℝ E) : PositiveCompacts E
    where
  carrier := parallelepiped b
  is_compact' :=
    isCompact_Icc.image
      (continuous_finset_sum Finset.univ fun (i : ι) (H : i ∈ Finset.univ) =>
        (continuous_apply i).smul continuous_const)
  interior_nonempty' :=
    by
    suffices H : Set.Nonempty (interior (b.equiv_funL.symm.to_homeomorph '' Icc 0 1))
    · dsimp only [parallelepiped]
      convert H
      ext t
      exact (b.equiv_fun_symm_apply t).symm
    have A : Set.Nonempty (interior (Icc (0 : ι → ℝ) 1)) :=
      by
      rw [← pi_univ_Icc, interior_pi_set (@finite_univ ι _)]
      simp only [univ_pi_nonempty_iff, Pi.zero_apply, Pi.one_apply, interior_Icc, nonempty_Ioo,
        zero_lt_one, imp_true_iff]
    rwa [← Homeomorph.image_interior, nonempty_image_iff]
#align basis.parallelepiped Basis.parallelepiped

variable [MeasurableSpace E] [BorelSpace E]

/-- The Lebesgue measure associated to a basis, giving measure `1` to the parallelepiped spanned
by the basis. -/
irreducible_def Basis.addHaar (b : Basis ι ℝ E) : Measure E :=
  Measure.add_haar_measure b.parallelepiped
#align basis.add_haar Basis.addHaar

instance isAddHaarMeasureBasisAddHaar (b : Basis ι ℝ E) : IsAddHaarMeasure b.add_haar :=
  by
  rw [Basis.addHaar]
  exact measure.is_add_haar_measure_add_haar_measure _
#align is_add_haar_measure_basis_add_haar isAddHaarMeasureBasisAddHaar

theorem Basis.addHaar_self (b : Basis ι ℝ E) : b.add_haar (parallelepiped b) = 1 :=
  by
  rw [Basis.addHaar]
  exact add_haar_measure_self
#align basis.add_haar_self Basis.addHaar_self

end NormedSpace

/-- A finite dimensional inner product space has a canonical measure, the Lebesgue measure giving
volume `1` to the parallelepiped spanned by any orthonormal basis. We define the measure using
some arbitrary choice of orthonormal basis. The fact that it works with any orthonormal basis
is proved in `orthonormal_basis.volume_parallelepiped`. -/
instance (priority := 100) measureSpaceOfInnerProductSpace [NormedAddCommGroup E]
    [InnerProductSpace ℝ E] [FiniteDimensional ℝ E] [MeasurableSpace E] [BorelSpace E] :
    MeasureSpace E where volume := (stdOrthonormalBasis ℝ E).toBasis.add_haar
#align measure_space_of_inner_product_space measureSpaceOfInnerProductSpace

/- This instance should not be necessary, but Lean has difficulties to find it in product
situations if we do not declare it explicitly. -/
instance Real.measureSpace : MeasureSpace ℝ := by infer_instance
#align real.measure_space Real.measureSpace


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.metric_space.lipschitz
import topology.uniform_space.complete_separated

/-!
# Antilipschitz functions

We say that a map `f : α → β` between two (extended) metric spaces is
`antilipschitz_with K`, `K ≥ 0`, if for all `x, y` we have `edist x y ≤ K * edist (f x) (f y)`.
For a metric space, the latter inequality is equivalent to `dist x y ≤ K * dist (f x) (f y)`.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ℝ≥0∞`. We do not require `0 < K` in the definition, mostly because
we do not have a `posreal` type.
-/

variables {α : Type*} {β : Type*} {γ : Type*}

open_locale nnreal uniformity
open set

/-- We say that `f : α → β` is `antilipschitz_with K` if for any two points `x`, `y` we have
`K * edist x y ≤ edist (f x) (f y)`. -/
def antilipschitz_with [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0) (f : α → β) :=
∀ x y, edist x y ≤ K * edist (f x) (f y)

lemma antilipschitz_with_iff_le_mul_dist [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} : antilipschitz_with K f ↔ ∀ x y, dist x y ≤ K * dist (f x) (f y) :=
by { simp only [antilipschitz_with, edist_nndist, dist_nndist], norm_cast }

alias antilipschitz_with_iff_le_mul_dist ↔ antilipschitz_with.le_mul_dist
  antilipschitz_with.of_le_mul_dist

lemma antilipschitz_with.mul_le_dist [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} (hf : antilipschitz_with K f) (x y : α) : ↑K⁻¹ * dist x y ≤ dist (f x) (f y) :=
begin
  by_cases hK : K = 0, by simp [hK, dist_nonneg],
  rw [nnreal.coe_inv, ← div_eq_inv_mul],
  rw div_le_iff' (nnreal.coe_pos.2 $ pos_iff_ne_zero.2 hK),
  exact hf.le_mul_dist x y
end

namespace antilipschitz_with

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {K : ℝ≥0} {f : α → β}

/-- Extract the constant from `hf : antilipschitz_with K f`. This is useful, e.g.,
if `K` is given by a long formula, and we want to reuse this value. -/
@[nolint unused_arguments] -- uses neither `f` nor `hf`
protected def K (hf : antilipschitz_with K f) : ℝ≥0 := K

protected lemma injective {α : Type*} {β : Type*} [emetric_space α] [pseudo_emetric_space β]
  {K : ℝ≥0} {f : α → β} (hf : antilipschitz_with K f) : function.injective f :=
λ x y h, by simpa only [h, edist_self, mul_zero, edist_le_zero] using hf x y

lemma mul_le_edist (hf : antilipschitz_with K f) (x y : α) :
  ↑K⁻¹ * edist x y ≤ edist (f x) (f y) :=
begin
  by_cases hK : K = 0, by simp [hK],
  rw [ennreal.coe_inv hK, mul_comm, ← div_eq_mul_inv],
  apply ennreal.div_le_of_le_mul,
  rw mul_comm,
  exact hf x y
end

protected lemma id : antilipschitz_with 1 (id : α → α) :=
λ x y, by simp only [ennreal.coe_one, one_mul, id, le_refl]

lemma comp {Kg : ℝ≥0} {g : β → γ} (hg : antilipschitz_with Kg g)
  {Kf : ℝ≥0} {f : α → β} (hf : antilipschitz_with Kf f) :
  antilipschitz_with (Kf * Kg) (g ∘ f) :=
λ x y,
calc edist x y ≤ Kf * edist (f x) (f y) : hf x y
... ≤ Kf * (Kg * edist (g (f x)) (g (f y))) : ennreal.mul_left_mono (hg _ _)
... = _ : by rw [ennreal.coe_mul, mul_assoc]

lemma restrict (hf : antilipschitz_with K f) (s : set α) :
  antilipschitz_with K (s.restrict f) :=
λ x y, hf x y

lemma cod_restrict (hf : antilipschitz_with K f) {s : set β} (hs : ∀ x, f x ∈ s) :
  antilipschitz_with K (s.cod_restrict f hs) :=
λ x y, hf x y

lemma to_right_inv_on' {s : set α} (hf : antilipschitz_with K (s.restrict f))
  {g : β → α} {t : set β} (g_maps : maps_to g t s) (g_inv : right_inv_on g f t) :
  lipschitz_with K (t.restrict g) :=
λ x y, by simpa only [restrict_apply, g_inv x.mem, g_inv y.mem, subtype.edist_eq, subtype.coe_mk]
  using hf ⟨g x, g_maps x.mem⟩ ⟨g y, g_maps y.mem⟩

lemma to_right_inv_on (hf : antilipschitz_with K f) {g : β → α} {t : set β}
  (h : right_inv_on g f t) :
  lipschitz_with K (t.restrict g) :=
(hf.restrict univ).to_right_inv_on' (maps_to_univ g t) h

lemma to_right_inverse (hf : antilipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
  lipschitz_with K g :=
begin
  intros x y,
  have := hf (g x) (g y),
  rwa [hg x, hg y] at this
end

lemma comap_uniformity_le (hf : antilipschitz_with K f) :
  (𝓤 β).comap (prod.map f f) ≤ 𝓤 α :=
begin
  refine ((uniformity_basis_edist.comap _).le_basis_iff uniformity_basis_edist).2 (λ ε h₀, _),
  refine ⟨K⁻¹ * ε, ennreal.mul_pos.2 ⟨ennreal.inv_pos.2 ennreal.coe_ne_top, h₀⟩, _⟩,
  refine λ x hx, (hf x.1 x.2).trans_lt _,
  rw [mul_comm, ← div_eq_mul_inv] at hx,
  rw mul_comm,
  exact ennreal.mul_lt_of_lt_div hx
end

protected lemma uniform_inducing (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  uniform_inducing f :=
⟨le_antisymm hf.comap_uniformity_le hfc.le_comap⟩

protected lemma uniform_embedding {α : Type*} {β : Type*} [emetric_space α] [pseudo_emetric_space β]
  {K : ℝ≥0} {f : α → β} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  uniform_embedding f :=
⟨hf.uniform_inducing hfc, hf.injective⟩

lemma is_complete_range [complete_space α] (hf : antilipschitz_with K f)
  (hfc : uniform_continuous f) : is_complete (range f) :=
(hf.uniform_inducing hfc).is_complete_range

lemma is_closed_range {α β : Type*} [pseudo_emetric_space α] [emetric_space β] [complete_space α]
  {f : α → β} {K : ℝ≥0} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  is_closed (range f) :=
(hf.is_complete_range hfc).is_closed

lemma closed_embedding {α : Type*} {β : Type*} [emetric_space α] [emetric_space β] {K : ℝ≥0}
  {f : α → β} [complete_space α] (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  closed_embedding f :=
{ closed_range := hf.is_closed_range hfc,
  .. (hf.uniform_embedding hfc).embedding }

lemma subtype_coe (s : set α) : antilipschitz_with 1 (coe : s → α) :=
antilipschitz_with.id.restrict s

lemma of_subsingleton [subsingleton α] {K : ℝ≥0} : antilipschitz_with K f :=
λ x y, by simp only [subsingleton.elim x y, edist_self, zero_le]

end antilipschitz_with

namespace antilipschitz_with

open metric

variables [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0} {f : α → β}

lemma bounded_preimage (hf : antilipschitz_with K f)
  {s : set β} (hs : bounded s) :
  bounded (f ⁻¹' s) :=
exists.intro (K * diam s) $ λ x y hx hy,
calc dist x y ≤ K * dist (f x) (f y) : hf.le_mul_dist x y
... ≤ K * diam s : mul_le_mul_of_nonneg_left (dist_le_diam_of_mem hs hx hy) K.2

/-- The image of a proper space under an expanding onto map is proper. -/
protected lemma proper_space {α : Type*} [metric_space α] {K : ℝ≥0} {f : α → β} [proper_space α]
  (hK : antilipschitz_with K f) (f_cont : continuous f) (hf : function.surjective f) :
  proper_space β :=
begin
  apply proper_space_of_compact_closed_ball_of_le 0 (λx₀ r hr, _),
  let K := f ⁻¹' (closed_ball x₀ r),
  have A : is_closed K := is_closed_ball.preimage f_cont,
  have B : bounded K := hK.bounded_preimage bounded_closed_ball,
  have : is_compact K := compact_iff_closed_bounded.2 ⟨A, B⟩,
  convert this.image f_cont,
  exact (hf.image_preimage _).symm
end

end antilipschitz_with

lemma lipschitz_with.to_right_inverse [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
  {f : α → β} (hf : lipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
  antilipschitz_with K g :=
λ x y, by simpa only [hg _] using hf (g x) (g y)


import algebra.field
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.point
import gtm106.weierstrass_equation.intersection_with_line
import myhelper.mypoly.basic
import tactic

namespace weierstrass_equation

-- ================
-- P ↦ -P
-- ================

def neg_of_affine_plane_point
{K : Type*} [comm_ring K] (E : weierstrass_equation K)
(P : affine_plane_point K) : affine_plane_point K
:= ⟨ P.x, -P.y - E.a1*P.x - E.a3 ⟩

lemma neg_of_affine_plane_point.self_eq_neg_iff
{K : Type*} [comm_ring K] (E : weierstrass_equation K)
(P : affine_plane_point K)
: P = E.neg_of_affine_plane_point P ↔ 2*P.y + E.a1*P.x + E.a3 = 0 :=
begin
  simp [neg_of_affine_plane_point, affine_plane_point.ext_iff],
  split, {
    intro h,
    rw ← sub_eq_zero.2 h,
    ring,
  },
  intro h,
  rw [← sub_eq_zero, ← h],
  ring,
end

@[simp]
lemma neg_of_neg_of_affine_plane_point
{K : Type*} [comm_ring K] (E : weierstrass_equation K)
(P : affine_plane_point K)
: E.neg_of_affine_plane_point (E.neg_of_affine_plane_point P) = P :=
begin
  simp [neg_of_affine_plane_point, affine_plane_point.ext_iff],
  ring,
end

@[simp]
lemma eval_at_affine_point.neg
{K : Type*} [comm_ring K] (E : weierstrass_equation K)
(P : affine_plane_point K)
: E.eval_at_affine_point (E.neg_of_affine_plane_point P) = E.eval_at_affine_point P :=
begin
  simp [neg_of_affine_plane_point, affine_point_on_curve, eval_at_affine_point],
  ring,
end

@[simp]
lemma affine_point_on_curve.neg
{K : Type*} [comm_ring K] (E : weierstrass_equation K)
(P : affine_plane_point K)
: E.affine_point_on_curve (E.neg_of_affine_plane_point P) ↔ E.affine_point_on_curve P :=
begin
  simp [affine_point_on_curve],
end

lemma same_x_implies_same_or_neg
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_plane_point K)
(h1 : E.affine_point_on_curve P1)
(h2 : E.affine_point_on_curve P2)
(hx : P1.x - P2.x = 0)
: P1.y - P2.y = 0 ∨ P1.y + P2.y + E.a1*P1.x + E.a3 = 0 :=
begin
  rw sub_eq_zero at hx,
  unfold affine_point_on_curve eval_at_affine_point at h1 h2,
  rw ← hx at h2,
  repeat { rw sub_sub at h1 h2 },
  rw sub_eq_zero at h1 h2,
  have h3 := congr (congr_arg has_sub.sub h1) h2,
  simp at h3,
  replace h3 : (P1.y - P2.y) * (P1.y + P2.y + E.a1*P1.x + E.a3) = 0 := by {
    rw ← h3, ring,
  },
  exact mul_eq_zero.1 h3,
end

lemma same_x_implies_same_or_neg'
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_plane_point K)
(h1 : E.affine_point_on_curve P1)
(h2 : E.affine_point_on_curve P2)
(hx : P1.x - P2.x = 0)
: P1 = P2 ∨ P1 = E.neg_of_affine_plane_point P2 :=
begin
  cases same_x_implies_same_or_neg P1 P2 h1 h2 hx with hy hy, {
    left,
    rw sub_eq_zero at hx hy,
    simp [affine_plane_point.ext_iff, hx, hy],
  },
  right,
  rw sub_eq_zero at hx,
  simp [neg_of_affine_plane_point, affine_plane_point.ext_iff, hx],
  rw [← sub_eq_zero, ← hy, hx],
  ring,
end

-- ================
-- P ↦ -2*P
-- ================

namespace neg_of_double_of_affine_plane_point

section

parameters {K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K)

def A : K := 3*P.x^2 + 2*E.a2*P.x + E.a4 - E.a1*P.y
-- def B : K := -P.x^3 + E.a4*P.x + 2*E.a6 - E.a3*P.y -- we avoid using B
def C : K := 2*P.y + E.a1*P.x + E.a3
def x : K := (A/C + E.a1)*(A/C) - E.a2 - 2*P.x -- we avoid using (A/C)^2
def y : K := P.y + (x - P.x)*(A/C) -- we avoid using B

def iwl : intersection_with_line K := intersection_with_line.from_point E P (A/C)

@[simp]
lemma iwl_E
: iwl.E = E := rfl

lemma A1 : A = - E.eval_dx_at_affine_point P :=
sub_eq_zero.1 begin
  simp only [A, eval_dx_at_affine_point],
  ring,
end

lemma C1 : C = E.eval_dy_at_affine_point P :=
begin
  simp only [C, eval_dy_at_affine_point],
end

lemma C' (h : E.affine_point_on_curve P)
: C^2 = 4*P.x^3 + E.b2*P.x^2 + 2*E.b4*P.x + E.b6 :=
sub_eq_zero.1 begin
  transitivity E.eval_at_affine_point P * 4, {
    rw ← sub_eq_zero,
    simp only [eval_at_affine_point, C, b2, b4, b6],
    ring,
  },
  unfold affine_point_on_curve at h,
  simp [h],
end

lemma x' (h : E.affine_point_on_curve P) (hC : C ≠ 0)
: x = (P.x^4 - E.b4*P.x^2 - 2*E.b6*P.x - E.b8) / (4*P.x^3 + E.b2*P.x^2 + 2*E.b4*P.x + E.b6) :=
sub_eq_zero.1 begin
  simp only [← C' E P h, x],
  field_simp [hC],
  transitivity ((A E P + E.a1 * C E P) * A E P
  - C E P * C E P * (E.a2 + 2 * P.x)
  - (P.x ^ 4 - E.b4 * P.x ^ 2 - 2 * E.b6 * P.x - E.b8)) * (C E P)^2,
  { rw ← sub_eq_zero, ring, },
  simp [hC],
  transitivity E.eval_at_affine_point P * (-E.a1^2 - 4*E.a2 - 8*P.x), {
    rw ← sub_eq_zero,
    simp only [eval_at_affine_point, A, C, b4, b6, b8],
    ring,
  },
  unfold affine_point_on_curve at h,
  simp [h],
end

lemma iwl_x0 (h : E.affine_point_on_curve P) (hC : C ≠ 0)
: iwl.poly.is_multiple_root P.x :=
begin
  unfold iwl,
  rw [intersection_with_line.is_on_2', intersection_with_line.point_this],
  simp [h, A1, ← C1, hC],
end

lemma iwl_x'
: x = - iwl.poly.a - 2 * P.x :=
begin
  simp only [iwl, intersection_with_line.from_point,
    intersection_with_line.poly,
    intersection_with_line.a, x],
  ring,
end

lemma iwl_x1 (h : E.affine_point_on_curve P) (hC : C ≠ 0)
: iwl.poly.is_root x :=
begin
  rw iwl_x',
  exact (iwl E P).poly.vieta_2 _ (iwl_x0 E P h hC),
end

lemma iwl_p
: iwl.point x = ⟨ x, y ⟩ :=
begin
  simp [iwl, intersection_with_line.from_point,
    intersection_with_line.point, y],
  ring,
end

end

lemma C_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K)
: C E (E.neg_of_affine_plane_point P) = -C E P :=
sub_eq_zero.1 begin
  simp only [C, neg_of_affine_plane_point],
  ring,
end

lemma x_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P) (hC : C E P ≠ 0)
: x E (E.neg_of_affine_plane_point P) = x E P :=
begin
  rw x' E P h hC,
  rw x' E (E.neg_of_affine_plane_point P) (by simp [h]) (by simp [C_of_neg E P, hC]),
  simp only [neg_of_affine_plane_point],
end

lemma y_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P) (hC : C E P ≠ 0)
: y E (E.neg_of_affine_plane_point P) = - y E P - E.a1 * x E P - E.a3 :=
sub_eq_zero.1 begin
  simp only [y, x_of_neg E P h hC, C_of_neg],
  simp only [neg_of_affine_plane_point, A],
  field_simp [hC],
  simp only [C],
  ring,
end

end neg_of_double_of_affine_plane_point

/--
NOTE: P should not be a 2-torsion, otherwise the result is incorrect
-/
def neg_of_double_of_affine_plane_point
{K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K) : affine_plane_point K :=
⟨ neg_of_double_of_affine_plane_point.x E P,
  neg_of_double_of_affine_plane_point.y E P ⟩

namespace neg_of_double_of_affine_plane_point

lemma neg {K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P) (hC : C E P ≠ 0)
: E.neg_of_double_of_affine_plane_point (E.neg_of_affine_plane_point P)
= E.neg_of_affine_plane_point (E.neg_of_double_of_affine_plane_point P) :=
begin
  simp only [neg_of_double_of_affine_plane_point, affine_plane_point.ext_iff,
    x_of_neg E P h hC, y_of_neg E P h hC],
  simp [neg_of_affine_plane_point],
end

end neg_of_double_of_affine_plane_point

lemma affine_point_on_curve.neg_of_double
{K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P)
(hy : 2*P.y + E.a1*P.x + E.a3 ≠ 0)
: E.affine_point_on_curve (E.neg_of_double_of_affine_plane_point P) :=
begin
  change neg_of_double_of_affine_plane_point.C E P ≠ 0 at hy,
  unfold neg_of_double_of_affine_plane_point,
  rw [← neg_of_double_of_affine_plane_point.iwl_p],
  have h1 := intersection_with_line.is_on'
    (neg_of_double_of_affine_plane_point.iwl E P)
    (neg_of_double_of_affine_plane_point.x E P),
  simp at h1,
  rw ← h1,
  exact neg_of_double_of_affine_plane_point.iwl_x1 E P h hy,
end

-- ================
-- (P1, P2) ↦ -(P1 + P2)
-- ================

namespace neg_of_add_of_affine_plane_point

section

parameters {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)

def A : K := P1.y - P2.y
-- def B : K := P2.y*P1.x - P1.y*P2.x -- we avoid using B
def C : K := P1.x - P2.x
def x : K := (A/C + E.a1)*(A/C) - E.a2 - P1.x - P2.x -- we avoid using (A/C)^2
def y : K := P1.y + (x - P1.x)*(A/C) -- we avoid using B

def iwl : intersection_with_line K := intersection_with_line.from_point E P1 (A/C)

@[simp]
lemma iwl_E
: iwl.E = E := rfl

lemma iwl_p1
: iwl.point P1.x = P1 :=
begin
  unfold iwl,
  exact intersection_with_line.point_this E P1 _,
end

lemma iwl_p2
(hx : P1.x - P2.x ≠ 0)
: iwl.point P2.x = P2 :=
begin
  simp [iwl, intersection_with_line.from_point,
    intersection_with_line.point,
    affine_plane_point.ext_iff, A, C],
  field_simp [hx],
  ring,
end

lemma iwl_p3
(hx : P1.x - P2.x ≠ 0)
: iwl.point x = ⟨ x, y ⟩ :=
begin
  simp [iwl, intersection_with_line.from_point,
    intersection_with_line.point, y, A, C],
  field_simp [hx],
  ring,
end

lemma iwl_x1 (h : E.affine_point_on_curve P1)
: iwl.poly.is_root P1.x :=
begin
  rw [intersection_with_line.is_on', iwl_p1],
  exact h,
end

lemma iwl_x2 (h : E.affine_point_on_curve P2)
(hx : P1.x - P2.x ≠ 0)
: iwl.poly.is_root P2.x :=
begin
  rw [intersection_with_line.is_on', iwl_p2 E P1 P2 hx],
  exact h,
end

lemma iwl_x'
: x = - iwl.poly.a - P1.x - P2.x :=
begin
  simp [iwl, intersection_with_line.poly, intersection_with_line.a,
    intersection_with_line.from_point, x],
end

lemma iwl_x3 (h1 : E.affine_point_on_curve P1)
(h2 : E.affine_point_on_curve P2)
(hx : P1.x - P2.x ≠ 0)
: iwl.poly.is_root x :=
begin
  rw iwl_x',
  exact (iwl E P1 P2).poly.vieta P1.x P2.x (iwl_x1 E P1 P2 h1)
    (iwl_x2 E P1 P2 h2 hx) (sub_ne_zero.1 hx),
end

lemma y' (hC : C ≠ 0) : y = P2.y + (x - P2.x)*(A/C) :=
begin
  simp only [y, A],
  field_simp [hC],
  unfold C,
  ring,
end

end

lemma A_of_comm {K : Type*} [field K]
(P1 P2 : affine_plane_point K)
: A P2 P1 = - A P1 P2 := by simp [A]

lemma C_of_comm {K : Type*} [field K]
(P1 P2 : affine_plane_point K)
: C P2 P1 = - C P1 P2 := by simp [C]

lemma A_over_C_of_comm {K : Type*} [field K]
(P1 P2 : affine_plane_point K)
: A P2 P1 / C P2 P1 = A P1 P2 / C P1 P2 :=
begin
  rw [A_of_comm P1 P2, C_of_comm P1 P2],
  by_cases hC : C P1 P2 = 0, {
    simp [hC],
  },
  field_simp [hC],
end

lemma x_of_comm {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
: x E P2 P1 = x E P1 P2 :=
sub_eq_zero.1 begin
  simp only [x, A_over_C_of_comm P1 P2],
  ring,
end

lemma y_of_comm {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(hx : P1.x - P2.x ≠ 0)
: y E P2 P1 = y E P1 P2 :=
begin
  simp only [y, y' E P1 P2 hx, x_of_comm E P1 P2, A_over_C_of_comm P1 P2],
end

lemma A_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
: A (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2)
= - A P1 P2 - E.a1 * C P1 P2 :=
begin
  simp [A, C, neg_of_affine_plane_point],
  ring,
end

lemma C_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
: C (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2)
= C P1 P2 :=
begin
  simp [C, neg_of_affine_plane_point],
end

lemma A_over_C_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(hx : P1.x - P2.x ≠ 0)
: A (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2)
/ C (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2)
= - A P1 P2 / C P1 P2 - E.a1 :=
begin
  simp [A_of_neg, C_of_neg],
  change C P1 P2 ≠ 0 at hx,
  field_simp [hx],
  ring,
end

lemma x_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(hx : P1.x - P2.x ≠ 0)
: x E (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2) = x E P1 P2 :=
sub_eq_zero.1 begin
  simp only [x, A_over_C_of_neg E P1 P2 hx],
  simp only [neg_of_affine_plane_point],
  ring,
end

lemma y_of_neg {K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(hx : P1.x - P2.x ≠ 0)
: y E (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2)
= - y E P1 P2 - E.a1 * x E P1 P2 - E.a3 :=
sub_eq_zero.1 begin
  simp only [y, x_of_neg E P1 P2 hx, A_over_C_of_neg E P1 P2 hx],
  simp only [neg_of_affine_plane_point],
  ring,
end

end neg_of_add_of_affine_plane_point

/--
NOTE: P1.x and P2.x should be different, otherwise the result is incorrect
-/
def neg_of_add_of_affine_plane_point
{K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K) : affine_plane_point K :=
⟨ neg_of_add_of_affine_plane_point.x E P1 P2,
  neg_of_add_of_affine_plane_point.y E P1 P2 ⟩

namespace neg_of_add_of_affine_plane_point

lemma comm
{K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(hx : P1.x - P2.x ≠ 0)
: E.neg_of_add_of_affine_plane_point P1 P2 = E.neg_of_add_of_affine_plane_point P2 P1 :=
begin
  simp [neg_of_add_of_affine_plane_point, affine_plane_point.ext_iff,
    x_of_comm E P1 P2, y_of_comm E P1 P2 hx],
end

lemma neg
{K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(hx : P1.x - P2.x ≠ 0)
: E.neg_of_add_of_affine_plane_point (E.neg_of_affine_plane_point P1) (E.neg_of_affine_plane_point P2)
= E.neg_of_affine_plane_point (E.neg_of_add_of_affine_plane_point P1 P2) :=
begin
  simp only [neg_of_add_of_affine_plane_point, affine_plane_point.ext_iff,
    x_of_neg E P1 P2 hx, y_of_neg E P1 P2 hx],
  simp [neg_of_affine_plane_point],
end

end neg_of_add_of_affine_plane_point

lemma affine_point_on_curve.neg_of_add
{K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K)
(h1 : E.affine_point_on_curve P1)
(h2 : E.affine_point_on_curve P2)
(hx : P1.x - P2.x ≠ 0)
: E.affine_point_on_curve (E.neg_of_add_of_affine_plane_point P1 P2) :=
begin
  unfold neg_of_add_of_affine_plane_point,
  rw [← neg_of_add_of_affine_plane_point.iwl_p3 E P1 P2 hx],
  have h := intersection_with_line.is_on'
    (neg_of_add_of_affine_plane_point.iwl E P1 P2)
    (neg_of_add_of_affine_plane_point.x E P1 P2),
  simp at h,
  rw ← h,
  exact neg_of_add_of_affine_plane_point.iwl_x3 E P1 P2 h1 h2 hx,
end

namespace affine_point

def neg
{K : Type*} [comm_ring K] {E : weierstrass_equation K}
: affine_point E → affine_point E
| infinite := infinite
| (finite P h) := finite (E.neg_of_affine_plane_point P)
  ((affine_point_on_curve.neg E P).2 h)

@[simp]
lemma neg_of_neg
{K : Type*} [comm_ring K] {E : weierstrass_equation K}
(P : affine_point E) : P.neg.neg = P :=
match P with
| infinite := by {
  simp [neg],
}
| (finite P h) := by {
  simp [neg],
}
end

noncomputable def neg_of_add
{K : Type*} [field K] {E : weierstrass_equation K}
: affine_point E → affine_point E → affine_point E
| infinite P := P.neg
| P infinite := P.neg
| (finite P1 h1) (finite P2 h2) := by {
  by_cases hx : P1.x - P2.x = 0, {
    by_cases hy : P1.y + P2.y + E.a1*P1.x + E.a3 = 0, {
      exact infinite,
    },
    exact finite (E.neg_of_double_of_affine_plane_point P1)
      (affine_point_on_curve.neg_of_double E P1 h1 (by {
        have h := same_x_implies_same_or_neg P1 P2 h1 h2 hx,
        simp [hy, sub_eq_zero] at h,
        rw [← h, ← two_mul] at hy,
        exact hy,
      })),
  },
  exact finite (E.neg_of_add_of_affine_plane_point P1 P2)
    (affine_point_on_curve.neg_of_add E P1 P2 h1 h2 hx),
}

lemma neg_of_add.comm
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_point E)
: P1.neg_of_add P2 = P2.neg_of_add P1 :=
match P1, P2 with
| infinite, infinite := by {
  simp [neg_of_add],
}
| infinite, (finite P2 h2) := by {
  simp [neg_of_add],
}
| (finite P1 h1), infinite := by {
  simp [neg_of_add],
}
| (finite P1 h1), (finite P2 h2) := by {
  simp [neg_of_add],
  by_cases hx : P1.x - P2.x = 0, {
    have hx' := sub_eq_zero.2 (sub_eq_zero.1 hx).symm,
    simp [hx, hx'],
    by_cases hy : P1.y + P2.y + E.a1*P1.x + E.a3 = 0, {
      have hy' := hy,
      rw [add_comm P1.y P2.y, sub_eq_zero.1 hx] at hy',
      simp [hy, hy'],
    },
    have hy' := hy,
    rw [add_comm P1.y P2.y, sub_eq_zero.1 hx] at hy',
    have h := same_x_implies_same_or_neg P1 P2 h1 h2 hx,
    simp [hy] at h,
    replace h := (affine_plane_point.ext_iff P1 P2).2 ⟨ sub_eq_zero.1 hx, sub_eq_zero.1 h ⟩,
    simp [hy, hy', h],
  },
  have hx' := sub_ne_zero.2 (sub_ne_zero.1 hx).symm,
  simp [hx, hx'],
  exact neg_of_add_of_affine_plane_point.comm E P1 P2 hx,
}
end

end affine_point

-- ================
-- (P1, P2) ↦ P1 + P2
-- ================

/--
NOTE: P should not be a 2-torsion, otherwise the result is incorrect
-/
def double_of_affine_plane_point
{K : Type*} [field K] (E : weierstrass_equation K)
(P : affine_plane_point K) : affine_plane_point K :=
E.neg_of_affine_plane_point (E.neg_of_double_of_affine_plane_point P)

/--
NOTE: P1.x and P2.x should be different, otherwise the result is incorrect
-/
def add_of_affine_plane_point
{K : Type*} [field K] (E : weierstrass_equation K)
(P1 P2 : affine_plane_point K) : affine_plane_point K :=
E.neg_of_affine_plane_point (E.neg_of_add_of_affine_plane_point P1 P2)

namespace affine_point

noncomputable def add
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_point E) : affine_point E
:= (P1.neg_of_add P2).neg

lemma add.comm
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_point E)
: P1.add P2 = P2.add P1 :=
begin
  unfold add,
  congr' 1,
  exact neg_of_add.comm P1 P2,
end

@[simp]
lemma add.zero_add
{K : Type*} [field K] {E : weierstrass_equation K}
(P : affine_point E)
: infinite.add P = P :=
match P with
| infinite := by {
  simp [add, neg_of_add],
}
| (finite P h) := by {
  simp [add, neg_of_add],
}
end

@[simp]
lemma add.add_zero
{K : Type*} [field K] {E : weierstrass_equation K}
(P : affine_point E)
: P.add infinite = P :=
match P with
| infinite := by {
  simp [add, neg_of_add],
}
| (finite P h) := by {
  simp [add, neg_of_add],
}
end

@[simp]
lemma add.add_left_neg
{K : Type*} [field K] {E : weierstrass_equation K}
(P : affine_point E)
: P.neg.add P = infinite :=
match P with
| infinite := by {
  simp [add, neg_of_add, neg],
}
| (finite P h) := by {
  simp [add, neg_of_add, neg,
    neg_of_affine_plane_point],
  dsimp only,
  have h : -P.y - E.a1 * P.x - E.a3 + P.y + E.a1 * P.x + E.a3 = 0 := by ring,
  simp [h, neg],
}
end

@[simp]
lemma add.add_right_neg
{K : Type*} [field K] {E : weierstrass_equation K}
(P : affine_point E)
: P.add P.neg = infinite :=
match P with
| infinite := by {
  simp [add, neg_of_add, neg],
}
| (finite P h) := by {
  simp [add, neg_of_add, neg,
    neg_of_affine_plane_point],
  dsimp only,
  have h : P.y + (-P.y - E.a1 * P.x - E.a3) + E.a1 * P.x + E.a3 = 0 := by ring,
  simp [h, neg],
}
end

lemma add.neg_add_neg
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_point E)
: (P1.neg).add P2.neg = P1.neg_of_add P2 :=
match P1, P2 with
| infinite, infinite := by {
  simp [add, neg, neg_of_add],
}
| infinite, (finite P2 h2) := by {
  simp [add, neg, neg_of_add],
}
| (finite P1 h1), infinite := by {
  simp [add, neg, neg_of_add],
}
| (finite P1 h1), (finite P2 h2) := by {
  simp [add, neg],
  by_cases hx : P1.x - P2.x = 0, {
    have hx' : (E.neg_of_affine_plane_point P1).x - (E.neg_of_affine_plane_point P2).x = 0 := by {
      simp only [neg_of_affine_plane_point, hx],
    },
    by_cases hy : P1.y + P2.y + E.a1*P1.x + E.a3 = 0, {
      have hy' : (E.neg_of_affine_plane_point P1).y + (E.neg_of_affine_plane_point P2).y + E.a1*(E.neg_of_affine_plane_point P1).x + E.a3 = 0, {
        replace hx := sub_eq_zero.1 hx,
        replace hy := congr_arg (λ x, -x) hy.symm,
        simp only [neg_zero] at hy,
        simp only [neg_of_affine_plane_point, hx, hy],
        ring,
      },
      simp [neg_of_add, hx, hx', hy, hy', neg],
    },
    have hP := same_x_implies_same_or_neg P1 P2 h1 h2 hx,
    simp [hy] at hP,
    replace hP : P1 = P2 := by {
      simp [affine_plane_point.ext_iff, sub_eq_zero.1 hx, sub_eq_zero.1 hP],
    },
    have hy' : (E.neg_of_affine_plane_point P1).y + (E.neg_of_affine_plane_point P2).y + E.a1*(E.neg_of_affine_plane_point P1).x + E.a3 ≠ 0, {
      replace hx := sub_eq_zero.1 hx,
      revert hy,
      contrapose,
      push_neg,
      intro hy,
      simp [neg_of_affine_plane_point] at hy,
      replace hy := congr (congr_arg has_add.add (eq.refl P1.y)) hy.symm,
      rw add_zero at hy,
      rw [hy, hx],
      ring,
    },
    simp [neg_of_add, hx, hx', hy, hy', neg],
    rw [← hP, ← two_mul] at hy,
    simp [neg_of_double_of_affine_plane_point.neg E P1 h1 hy],
  },
  have hx' : (E.neg_of_affine_plane_point P1).x - (E.neg_of_affine_plane_point P2).x ≠ 0 := by {
    simp only [neg_of_affine_plane_point], exact hx,
  },
  simp [neg_of_add, hx, hx', neg, neg_of_add_of_affine_plane_point.neg E P1 P2 hx],
}
end

lemma add.add_to_zero_iff_neg
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_point E)
: P1.add P2 = infinite ↔ P2 = P1.neg :=
match P1, P2 with
| infinite, infinite := by {
  simp [add, neg_of_add, neg],
}
| infinite, (finite P2 h2) := by {
  simp [add, neg_of_add, neg],
}
| (finite P1 h1), infinite := by {
  simp [add, neg_of_add, neg],
}
| (finite P1 h1), (finite P2 h2) := by {
  by_cases hx : P1.x - P2.x = 0, {
    by_cases hy : P1.y + P2.y + E.a1*P1.x + E.a3 = 0, {
      simp [add, neg_of_add, neg, hx, hy],
      replace hx := (sub_eq_zero.1 hx).symm,
      simp [neg_of_affine_plane_point, affine_plane_point.ext_iff, hx],
      rw [← sub_eq_zero, ← hy],
      ring,
    },
    simp [add, neg_of_add, neg, hx, hy],
    replace hx := (sub_eq_zero.1 hx).symm,
    simp [neg_of_affine_plane_point, affine_plane_point.ext_iff, hx],
    revert hy,
    contrapose,
    push_neg,
    intro hy,
    rw hy,
    ring,
  },
  simp [add, neg_of_add, neg, hx],
  simp [neg_of_affine_plane_point, affine_plane_point.ext_iff, (sub_ne_zero.1 hx).symm],
}
end

end affine_point

end weierstrass_equation


import data.nat.basic
import data.nat.prime
import data.nat.parity
import data.nat.factorial
import tactic.suggest
import data.real.basic
import modular
noncomputable theory
open_locale classical

/-
  This file gives some theorems and lemmas for demonstrating that a number is prime,
  along with some small examples.
-/

namespace nat

/-
  this is intended to be used in order to generate things of the form
  "a ≤ b → a = 0 ∨ ... ∨ a = b". The last one will be leq_succ_0 in order to have a ≤ 0
  replaced with a = 0.
-/
lemma leq_succ (a b : ℕ) : a ≤ b.succ ↔ a ≤ b ∨ a = b.succ :=
begin
  split,
  intro h,
  cases lt_or_eq_of_le h with le eq,
  left,
  exact lt_succ_iff.mp le,
  right,
  exact eq,
  intro h,
  cases h with leq suc,
  exact le_succ_of_le leq,
  exact (eq.symm suc).ge,
end

/-
  complementary to the leq_succ, useful for being the last rewrite statement in order to not
  have any inequalities in the term
-/
lemma leq_succ_0 (a : ℕ) : a ≤ 1 ↔ a = 0 ∨ a = 1 :=
begin
  rw ← le_zero_iff,
  exact leq_succ a 0,
end

-- delete
theorem leq_2_iff (a : ℕ): a ≤ 2 → a = 0 ∨ a = 1 ∨ a = 2 :=
begin
  induction a,
  intro h,
  left,
  refl,
  intro h,
  have hi : a_n = 0 ∨ a_n = 1 ∨ a_n = 2, {
    have h₂ : a_n ≤ 2, {
      calc a_n ≤ a_n.succ : le_succ a_n
        ...    ≤ 2        : h,
    },
    exact a_ih h₂,
  },
  cases hi with a b,
  right,
  left,
  exact congr_arg succ a,
  cases b with c d,
  right,
  right,
  exact congr_arg succ c,
  have h₃ : a_n.succ > 2, {
    calc a_n.succ > a_n : lt_add_one a_n
     ...          = 2   : d,
  },
  exfalso,
  linarith,
end

-- delete
theorem leq_3_iff (a : ℕ): a ≤ 3 → a = 0 ∨ a = 1 ∨ a = 2 ∨ a = 3 :=
begin
  rw [leq_succ a 2, leq_succ a 1, leq_succ_0 a],
  tauto,
end

theorem leq (a b : ℕ) : b ≠ 0 → a ∣ b → a ≤ b :=
begin
  intros h div,
  cases div with c hc,
  induction c,
  exfalso,
  rw mul_zero at hc,
  exact h hc,
  induction a,
  linarith,
  have ha : b = a_n.succ * c_n + a_n.succ, {
    calc b = a_n.succ * c_n.succ : hc
      ...  = a_n.succ * (c_n + 1) : rfl
      ...  = a_n.succ * c_n + a_n.succ : by ring,
  },
  rw le_iff_exists_add,
  use a_n.succ * c_n,
  rw add_comm,
  exact ha,
end

/-
  This theorem shows that you only need to check the prime factors up to
  the square root of p in order to demonstrate that p is prime.
-/
theorem prime_check_le_square_root (n p : ℕ) : n*n > p →
    (prime p ↔ (2 ≤ p ∧ ∀ m < n, m ∣ p → m = 1 ∨ m = p)) :=
begin
  intro h, split, intro prime, split,
  exact prime.left, intro m,
  have each := prime.right,
  specialize each m, intros leq div,
  cases each div with one p,
  left, exact one,
  right, exact p,

  intro hyp, split,
  exact hyp.left,
  intro m,
  cases lt_or_ge m n with le geq,
  have hyp := hyp.right,
  specialize hyp m,
  exact hyp le,
  intro div,
  cases div with c hc,
  have le : c < n, {
    by_contradiction H,
    push_neg at H,
    have contradict : p > p, {
      calc p = m * c : hc
        ...  ≥ n * n : mul_le_mul' geq H
        ...  > p     : h,
    },
    linarith,
  },
  have hyp := hyp.right,
  specialize hyp c,
  have div : c ∣ p, {use m, rw mul_comm, exact hc,},
  have or := hyp le div,
  cases or with one pe,
  right,
  rw [one, mul_one] at hc,
  rw hc, -- "exact" didnt work here, since we have p=m but needed m=p.
  left,
  rw pe at hc,
  -- these last three lines are really ugly and only establish injectivity of mult.
  -- probably at some point clean this up, but for now this works.
  have hneq : p ≠ 0, {linarith,},
  have hc : m * p = 1 * p, {linarith,},
  exact (mul_left_inj' hneq).1 hc,
end

theorem prime_2 : prime 2 :=
begin
  split, linarith,
  intros m h,
  have h₂ : m ≤ 2, {
    have h₃ : 2 ≠ 0, {exact two_ne_zero,},
    exact (leq m 2) h₃ h,
  },
  have h₃ : m = 0 ∨ m = 1 ∨ m = 2, {
    exact leq_2_iff m h₂,
  },
  cases h₃ with a b,
  exfalso,
  cases h with c hc,
  rw [a,zero_mul] at hc,
  linarith,
  exact b,
end

theorem prime_3 : prime 3 :=
begin
  unfold prime,
  split, linarith,
  intros m hm,
  have hl : m ≤ 3, {
    have neq : 3 ≠ 0, {linarith,},
    exact (leq m 3) neq hm,
  },
  have h : m = 0 ∨ m = 1 ∨ m = 2 ∨ m = 3, {exact leq_3_iff m hl,},
  cases h with zero h,
  {
    cases hm with c hc,
    rw zero at hc,
    rw zero_mul at hc,
    exfalso,
    linarith,
  },
  cases h with one h,
  {
    left,
    exact one,
  },
  cases h with two three,
  {
    exfalso,
    cases hm with c hc,
    rw two at hc,
    have h₁ : odd 3, {
      exact odd_bit1 1,
    },
    have h₂ : even (2 * c), {
      use c,
    },
    have h₃ : even 3, {
      rw ← hc at h₂,
      exact h₂,
    },
    have h₄ : ¬(even 3), {
      rw←odd_iff_not_even,
      exact h₁,
    },
    exact h₄ h₃,
  },
  right,
  exact three,
end

theorem not_prime_4 : ¬ prime 4 :=
begin
  unfold prime,
  push_neg,
  intro h,
  use 2,
  split,
  use 2,
  linarith,
  split,
  intro h,
  linarith,
  intro h,
  linarith,
end

theorem prime_5 : prime 5 :=
begin
  split,
  linarith,
  intros n h,
  have h5 : 5 ≠ 0, {linarith,},
  have hl : n ≤ 5, {exact leq _ _ h5 h,},
  have hor : n=0∨n=1∨n=2∨n=3∨n=4∨n=5, {
    rw [leq_succ n 4, leq_succ n 3, leq_succ n 2, leq_succ n 1, leq_succ_0 n] at hl,
    tauto,
  },
  cases hor with zero hor,
  {
    exfalso,
    cases h with c hc,
    rw zero at hc,
    have hzero : 5 = 0, {linarith,},
    exact h5 hzero,
  },
  cases hor with one hor,
  {
    left,
    exact one,
  },
  cases hor with two hor,
  {
    have hmod : mod 5 2 1, {use 2, linarith,},
    have ndiv : ¬ n ∣ 5, {
      apply mod_neq_0_not_div 5 n,
      use 1,
      split,
      linarith,
      split,
      linarith,
      use 2,
      linarith,
    },
    exfalso,
    exact ndiv h,
  },
  cases hor with three hor,
  {
    have ndiv : ¬ 3 ∣ 5, {
      apply mod_neq_0_not_div 5 3,
      use 2,
      split,
      linarith,
      use 1,
      ring,
    },
    rw three at h,
    exfalso,
    exact ndiv h,
  },
  cases hor with four five,
  {
    have ndiv : ¬ 4 ∣ 5, {
      apply mod_neq_0_not_div 5 4,
      use 1,
      split,
      linarith,
      use 1,
      ring,
    },
    rw four at h,
    exfalso,
    exact ndiv h,
  },
  {
    right,
    exact five,
  },
end

end nat


import algebra.ring.basic
import algebra.big_operators.basic
import algebra.group.units
import data.nat.basic
import data.polynomial.basic
import data.polynomial.coeff
import data.polynomial.degree.definitions
open finset tactic polynomial nat set
open_locale big_operators

variables {R : Type*} [comm_ring R] [nontrivial R]

lemma add_lt_of_lt_and_le {a b c d : ℕ} (h1 : a < b) (h2 : c ≤ d) :
  a + c < b + d :=
begin
  calc a + c < b + c : add_lt_add_right h1 c
  ... ≤ b + d : add_le_add_left h2 b,
end

lemma mul_left_of_eq {a b : R} (c : R) (h : a = b) : c * a = c * b :=
  by { rw h }

lemma mul_right_of_eq {a b : R} (c : R) (h : a = b) : a * c = b * c :=
  by { rw h }

lemma sub_sub' {a b : ℕ} (h : b ≤ a) : a - (a - b) = b :=
  by { rw [nat.sub_eq_iff_eq_add (nat.sub_le _ _),
            nat.add_sub_of_le h] }

lemma erase_nat_degree_lt {p : polynomial R} (dpos : p.nat_degree > 0) :
  (p.erase p.nat_degree).nat_degree < p.nat_degree :=
begin
  sorry
end

lemma erase_nat_degree_lt_or_zero (p : polynomial R) :
  p.nat_degree = 0 ∨ (p.erase p.nat_degree).nat_degree < p.nat_degree :=
begin
  by_cases hd : p.nat_degree = 0,
  { left, assumption },
  { right,
    change p.nat_degree ≠ 0 at hd,
    rw ←pos_iff_ne_zero at hd,
    exact erase_nat_degree_lt hd }
end

lemma erase_const_eq {p : polynomial R} (dpos : p.nat_degree > 0) :
  (p.erase p.nat_degree).coeff 0 = p.coeff 0 :=
begin
  rw [coeff_erase, if_neg],
  exact ne_iff_lt_or_gt.mpr (or.inl dpos)
end

lemma orig_sub_monomial (p : polynomial R) :
  p.erase p.nat_degree = p + -(monomial p.nat_degree) p.leading_coeff :=
begin
  conv_rhs { congr, rw ←(monomial_add_erase p p.nat_degree) },
  simp,
end

lemma erase_coeff_eq_orig {p : polynomial R} {n : ℕ} (h : ¬n = p.nat_degree) :
  (p.erase p.nat_degree).coeff n = p.coeff n :=
by { rwa [coeff_erase, if_neg] }

lemma erase_coeff_eq_orig_or_zero (p : polynomial R) (n : ℕ) :
  (p.erase p.nat_degree).coeff n = 0 ∨ (p.erase p.nat_degree).coeff n = p.coeff n :=
begin
  by_cases hn : n = p.nat_degree,
  { left, rwa [coeff_erase, if_pos] },
  { right, exact erase_coeff_eq_orig hn }
end

lemma reduce_to_erase {P : R → Prop} {p : polynomial R} (n : ℕ)
  (h1 : P p.leading_coeff)
  (h2 : ∀ n, P ((p.erase p.nat_degree).coeff n)) :
  P (p.coeff n) :=
begin
  by_cases hn : n = p.nat_degree,
  { convert h1 },
  { rw ←erase_coeff_eq_orig hn, exact h2 n }
end

lemma nat_degree_pow_le (p : polynomial R) (n : ℕ) :
  (p ^ n).nat_degree ≤ n * p.nat_degree :=
begin
  induction n with i hi,
  { simp },
  { rw [pow_succ, succ_mul, add_comm],
    calc (p * p ^ i).nat_degree ≤ p.nat_degree + (p ^ i).nat_degree : nat_degree_mul_le
    ... ≤ p.nat_degree + i * p.nat_degree : nat.add_le_add_left hi _ }
end

lemma coeff_pow_degree_mul_degree (p : polynomial R) (n : ℕ) :
  (p ^ n).coeff (n * p.nat_degree) = p.leading_coeff ^ n :=
begin
  induction n with i hi,
  { simp },
  { by_cases h : p.leading_coeff ^ i = 0; repeat { rw pow_succ' },
    { by_cases hp : p ^ i = 0; rw [h, zero_mul],
      { rw [hp, zero_mul, coeff_zero] },
      { have h1 : (p ^ i).nat_degree < i * p.nat_degree,
        { by_contra h',
          replace h' := eq_iff_le_not_lt.mpr ⟨nat_degree_pow_le p i, h'⟩,
          rw [←h', h] at hi,
          exact (leading_coeff_ne_zero.mpr hp) hi },

        have h2 : (p ^ i * p).nat_degree < i.succ * p.nat_degree,
          calc (p ^ i * p).nat_degree ≤ (p ^ i).nat_degree + p.nat_degree : nat_degree_mul_le
          ... <  i * p.nat_degree + p.nat_degree : nat.add_lt_add_right h1 _
          ... = i.succ * p.nat_degree : by rw ←succ_mul,
        rw coeff_eq_zero_of_nat_degree_lt h2 } },

    { rw [succ_mul, ←nat_degree_pow' h, ←leading_coeff_pow' h],
      exact coeff_mul_degree_add_degree _ _ } }
end


import data.matrix data.rat linear_algebra.basis data.fintype tactic.omega algebra.associated
import linear_algebra.determinant

open matrix fintype finset

variables {m n : ℕ}
variables (A : matrix (fin m) (fin n) ℚ)

notation `rvec` n := matrix (fin 1) (fin n) ℚ
notation `cvec` m := matrix (fin m) (fin 1) ℚ

def column (j : fin n) : cvec m := λ i _, A i j

def row (i : fin m) : rvec n := λ _ j, A i j

variables (b : cvec m) (c : cvec n)

instance : partial_order (matrix (fin m) (fin n) ℚ) := pi.partial_order

constant matrix.has_inv : has_inv (matrix (fin n) (fin n) ℚ)

local notation M `⬝` N := M.mul N
local postfix `ᵀ` : 1500 := transpose

def is_feasible (x : cvec n) : Prop :=
0 ≤ x ∧ A ⬝ x = b

instance decidable_le : decidable_rel ((≤) : matrix (fin m) (fin n) ℚ → matrix (fin m) (fin n) ℚ → Prop) :=
λ M N, show decidable (∀ i j, M i j ≤ N i j), by apply_instance

instance (x : cvec n) : decidable (is_feasible A b x) :=
by dunfold is_feasible; apply_instance

def is_optimal (x : cvec n) : Prop :=
is_feasible A b x ∧ ∀ y, is_feasible A b y → cᵀ ⬝ y ≤ cᵀ ⬝ x

@[simp] lemma finset.length_sort (s : finset (fin n)) : (s.sort (≤)).length = s.card := sorry

def is_invertible (M : matrix (fin m) (fin n) ℚ) : Prop :=
∃ h : m = n, by rw h at M; exact det M ≠ 0

instance is_invertible.decidable : decidable_pred (@is_invertible m n) :=
λ _, by unfold is_invertible; apply_instance

def comatrix (M : matrix (fin n) (fin n) ℚ) : matrix (fin n) (fin n) ℚ :=
begin
  cases n,
  { exact fin.elim0 },
  { exact λ i j, det (minor M
    (λ i' : fin n, if i'.1 < i.1 then i'.cast_le sorry
      else i'.succ)
    (λ j' : fin n, if j'.1 < j.1 then j'.cast_le sorry
      else j'.succ)) }
end
-- λ i j, det (minor M
--   (λ i' : fin (n - 1), if i'.1 < i.1 then i'.cast_le sorry
--     else i'.succ) _)

def inverse (M : matrix (fin m) (fin n) ℚ) : matrix (fin n) (fin m) ℚ :=
if h : m = n then by subst h; exact (det M)⁻¹ • (comatrix M)ᵀ else 0

def check_reduced_cost (x : cvec n) (B : finset (fin n)) : Prop :=
let permB : matrix (fin n) (fin B.card) ℚ :=
  minor 1 id (λ i, (finset.sort (≤) B).nth_le i.1 (by simpa using i.2)) in
let N : finset (fin n) := univ.filter (∉ B) in
let permN : matrix (fin n) (fin N.card) ℚ :=
  minor 1 id (λ i, (finset.sort (≤) N).nth_le i.1 (by simpa using i.2)) in
let basis := A ⬝ permB in
let non_basis := A ⬝ permN in
let ctN := cᵀ ⬝ permN in
let ctB := cᵀ ⬝ permB in
xᵀ ⬝ permN = 0 ∧ is_invertible basis ∧ ctN - ctB ⬝ inverse basis ⬝ non_basis ≤ 0
--linear_independent ℚ (↑(B.image (column A)) : set (cvec m))

instance (x : cvec n) (B : finset (fin n)) : decidable (check_reduced_cost A c x B) :=
by dunfold check_reduced_cost; apply_instance

lemma is_optimal_of_check_reduced_cost (x : cvec n) (B : finset (fin n)) :
  check_reduced_cost A c x B ∧ is_feasible A b x → is_optimal A b c x := sorry

def ex.A : matrix (fin 2) (fin 4) ℚ :=
  λ i j, (list.nth_le [[1,0,1,0], [1,2,0,1]] i sorry).nth_le j sorry

def ex.B : finset (fin 4) := {2,3}

def ex.c : cvec 4 := λ i _, (list.nth_le [1,1,0,0] i sorry)

def ex.b : cvec 2 := λ i _, (list.nth_le [2,4] i sorry)

def ex.x : cvec 4 := λ i _, (list.nth_le [0,0,2,4] i sorry)

#eval (is_feasible ex.A ex.b ex.x : bool)

--set_option trace.class_instances true
#eval (check_reduced_cost ex.A ex.c ex.x ex.B : bool)

def ex2.A : matrix (fin 2) (fin 4) ℚ :=
  λ i j, (list.nth_le [[1,0,1,0], [1,2,0,1]] i sorry).nth_le j sorry

def ex2.B : finset (fin 4) := {0,1}

def ex2.c : cvec 4 := λ i _, (list.nth_le [1,1,0,0] i sorry)

def ex2.b : cvec 2 := λ i _, (list.nth_le [2,4] i sorry)

def ex2.x : cvec 4 := λ i _, (list.nth_le [2,1,0,0] i sorry)

#eval (is_feasible ex2.A ex2.b ex2.x : bool)

#eval (check_reduced_cost ex2.A ex2.c ex2.x ex2.B : bool)