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

noncomputable theory
open_locale classical
open set function

@[protect_proj]
class subset (A : Type*) (B : out_param $ Type*) :=
(mem : B → A → Prop)

namespace subset
-- The following allows us to use the symbol `∈`
instance {A : Type*} {B : Type*} [subset A B] : has_mem B A := ⟨subset.mem⟩

-- This says that two "subset"s are equivalent (written `≈`, type with \approx) when
-- they have the same points.
instance {A : Type*} {B : Type*} [subset A B] : has_equiv A := ⟨λ X Y, ∀ t, t ∈ X ↔ t ∈ Y⟩
@[simp] lemma equiv_iff {A : Type*} {B : Type*} [subset A B] (X Y : A) : X ≈ Y ↔ ∀ t, t ∈ X ↔ t ∈ Y := iff.rfl

-- A "subset" can always be considered as an actual subset, in Lean this is `set B`
instance {A : Type*} {B : Type*} [subset A B] : has_coe_t A (set B) := ⟨λ x p, p ∈ x⟩

@[simp] lemma mem_pts  {A : Type*} {B : Type*} [subset A B] (a : A) (P : B) : P ∈ (a : set B) ↔ P ∈ a
:= iff.rfl

end subset

@[simp] def pts {A : Type*} {B : Type*} [subset A B] : A → set B := λ a, {x : B | x ∈ a}

/--
We define an incidence plane as having the undefined terms `Point` and `Line`,
a function `distance` that takes every two points to a real number, and a predicate
`belongs` that relates points and lines.

There are essentially two axioms: existence of two distinct points, and the incidence postulate.
-/
class IncidencePlane (Point : Type*) :=
	(distance : Point → Point → ℝ)
	(Line : Type*)
  (belongs : Point → Line → Prop)
	(infix `∈`:100 := belongs)

	-- Existence postulate
	(existence : ∃ P Q : Point, P ≠ Q)

	-- Incidence postulate is divided into 4 statements
	(line_through : Point → Point → Line)
	(line_through_left (P Q : Point) : P ∈ (line_through P Q))
	(line_through_right (P Q : Point) : Q ∈ (line_through P Q))
	(incidence {P Q : Point} {ℓ : Line} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q)

namespace IncidencePlane
variables {Ω : Type*} [IncidencePlane Ω]

-- From here on, we can use the symbol `∈` for Lines
instance : subset (Line Ω) Ω := {mem := belongs}

-- Here we state that Ω is nonempty (in fact it must have at least two distinct points!)
instance : nonempty Ω := nonempty_of_exists IncidencePlane.existence

/--
This lemma is a rephrasing of the incidence axiom that
doesn't mention `line_through`
-/
lemma equal_lines_of_contain_two_points {A B : Ω}	{r s : Line Ω}
(hAB: A ≠ B)	(hAr: A ∈ r) (hAs: A ∈ s) (hBr: B ∈ r) (hBs: B ∈ s) :	r = s :=
by rw [incidence hAB hAr hBr, incidence hAB hAs hBs]

-- Define collinearity of a set of points to mean that they all lie on some line
def collinear (S : set Ω) : Prop := ∃ (ℓ : Line Ω), ∀ {P : Ω}, P ∈ S → P ∈ ℓ

-- The next lemmas allow us to deal with collinearity of sets
meta def extfinish : tactic unit := `[ext, finish]
lemma collinear_of_equal (S T : set Ω) (h : S = T . extfinish) : (collinear S ↔ collinear T) :=
iff_of_eq (congr_arg collinear h)

lemma collinear_subset (S T : set Ω) (hST : S ⊆ T) : collinear T → collinear S :=
begin
	intro h,
	obtain ⟨ℓ, hℓ⟩ := h,
	exact ⟨ℓ, λ P hP, hℓ (hST hP)⟩,
end

lemma collinear_union (S T : set Ω) {P Q : Ω} (h : P ≠ Q) (hS : collinear S) (hT : collinear T)
(hPS : P ∈ S) (hPT : P ∈ T) (hQS : Q ∈ S) (hQT : Q ∈ T) : collinear (S ∪ T) :=
begin
	obtain ⟨u, hu⟩ := hS,
	obtain ⟨v, hv⟩ := hT,
	use u,
	have huv : u = v := equal_lines_of_contain_two_points h (hu hPS) (hv hPT) (hu hQS) (hv hQT),
	simp [←huv] at hv,
	finish,
end

/--
Say that  B is between A and C if they are collinear and AB + BC = AC. We will write A * B * C.
Note that this means that always A * A * C and A * C * C, in particular.
-/
def between (A B C : Ω) := collinear ({A, B, C} : set Ω) ∧ distance A B + distance B C = distance A C
notation A `*` B `*` C := IncidencePlane.between A B C

/--
Two lines intersect if they share a point
-/
def intersect (r s : Line Ω) : Prop := ∃ A, A ∈ r ∧ A ∈ s

/--
Two lines are parallel if they dont intersect (so a line is never parallel to itself)
-/
def parallel (r s : Line Ω) : Prop := ¬ intersect r s

/--
Next we introduce the notion of a Segment. A segment is the giving two points, A and B.
We will use the notation A⬝B to denote the segment denoted by A and B. The segment A⬝B consists
of all the points X such that A * X * B.

We will identify A⬝B with B⬝A, using the symbol ≈.
-/

structure Segment (Point : Type*) :=
(A : Point) (B : Point)

infix `⬝`:100 := Segment.mk

namespace Segment

-- Declare when P ∈ A⬝B
instance : subset (Segment Ω) Ω := { mem := λ P S, S.A * P * S.B }
@[simp] lemma mem_pts (S : Segment Ω) (P : Ω) : P ∈ S ↔ (S.A * P * S.B) := iff.rfl

/--
The length of a segment is defined to be the distance between its two endpoints
If S if a segment, we can use this definition writing `S.length`
-/
@[simp] def length (S : Segment Ω) := distance S.A S.B

/--
Two segments are said to be congruent (written ≅) if they have the same length
-/
@[simp] def congruent (S T : Segment Ω) := length S = length T
infix `≅`:100 := congruent

end Segment

/--
A set of points is convex if given two points P and Q in the set, the segment P⬝Q is contained in the set
-/
def is_convex (S : set Ω) := ∀ P Q : Ω, P ∈ S → Q ∈ S → pts (P⬝Q) ⊆ S

/--
Two points P and Q lie on the same side of a line ℓ if the segment P⬝Q doesn't intersect ℓ
-/
def same_side (ℓ : Line Ω) (P Q : Ω) :=  pts (P⬝Q) ∩ ℓ = ∅

/--
The half-plane determined by a line ℓ and a point P consists of all the points lying on the same side of P
Note : with this definition, the half plane determined by a point in ℓ is the empty set.
-/
def half_plane (ℓ : Line Ω) (P : Ω) := {Q | same_side ℓ P Q}

/--
Sometimes we will want to consider the closed half plane: all the points lying on the same
side of P, together with the line ℓ
-/
def closed_half_plane (ℓ : Line Ω) ( P : Ω) := (half_plane ℓ P) ∪ ℓ

structure Ray (Point : Type*):=
	(origin : Point) (target : Point)
infix `=>`:100 := Ray.mk

namespace Ray

instance : subset (Ray Ω) Ω := {mem := λ P r, (r.origin * P * r.target) ∨ (r.origin * r.target * P)}
@[simp] lemma mem_pts (r : Ray Ω) (P : Ω) : P ∈ r ↔ (r.origin * P * r.target) ∨ (r.origin * r.target * P) := iff.rfl
/--
The line determined by a ray
-/
def line (r : Ray Ω) : Line Ω := line_through r.origin r.target

/--
A ray is degenerate if its origin and target are the same
-/
@[simp] def degenerate (r : Ray Ω) := r.origin = r.target

/--
We say that non-degenerate rays r and s are `opposite` if they have the same origin, which is between the two targets
-/
def opposite (r s : Ray Ω) := ¬ r.degenerate ∧ ¬ s.degenerate ∧ r.origin = s.origin ∧ r.target * r.origin * s.target

end Ray

/-
ANGLES
-/

structure Angle (Point : Type*) := (A : Point) (O : Point) (B : Point)
notation `∟`:100 := Angle.mk

namespace Angle

def degenerate (α : Angle Ω) := collinear ({α.A, α.O, α.B} : set Ω)
def interior (α : Angle Ω) := closed_half_plane (line_through α.O α.A) α.B ∩ closed_half_plane (line_through α.O α.A) α.A
instance : has_equiv (Angle Ω) :=
⟨λ α β, ((α.O => α.A ≈ β.O => β.A) ∧ (α.O => α.B ≈ β.O => β.B)) ∨ ((α.O => α.A ≈ β.O => β.B) ∧ (α.O => α.B ≈ β.O => β.A))⟩

end Angle

structure Triangle (Point : Type*) :=
	(A : Point) (B : Point) (C : Point)
notation `▵`:100 := Triangle.mk

namespace Triangle

def degenerate (T: Triangle Ω) := collinear ({T.A, T.B, T.C} : set Ω)
def vertices (T : Triangle Ω) := [T.A, T.B, T.C]
def sides (T : Triangle Ω) := [(T.A⬝T.B).length, (T.B⬝T.C).length, (T.A⬝T.C).length]

instance : subset (Triangle Ω) Ω := {mem := λ P T, P ∈ T.A⬝T.B ∨ P ∈ T.B⬝T.C ∨ P ∈ T.A⬝T.C}

end Triangle

namespace Ray
def between (r s t : Ray Ω) := r.origin = s.origin ∧ s.origin = t.origin ∧ s.target ∈ Angle.interior (∟ r.target r.origin t.target)

end Ray

end IncidencePlane


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.matrix.determinant
import linear_algebra.matrix.nonsingular_inverse
import tactic.fin_cases

/-!
# Block matrices and their determinant

This file defines a predicate `matrix.block_triangular` saying a matrix
is block triangular, and proves the value of the determinant for various
matrices built out of blocks.

## Main definitions

 * `matrix.block_triangular` expresses that a `o` by `o` matrix is block triangular,
   if the rows and columns are ordered according to some order `b : o → α`

## Main results
  * `matrix.det_of_block_triangular`: the determinant of a block triangular matrix
    is equal to the product of the determinants of all the blocks
  * `matrix.det_of_upper_triangular` and `matrix.det_of_lower_triangular`: the determinant of
    a triangular matrix is the product of the entries along the diagonal

## Tags

matrix, diagonal, det, block triangular

-/

open finset function order_dual
open_locale big_operators matrix

universes v

variables {α β m n o : Type*} {m' n' : α → Type*}
variables {R : Type v} [comm_ring R] {M N : matrix m m R} {b : m → α}

namespace matrix

section has_lt
variables [has_lt α]

/-- Let `b` map rows and columns of a square matrix `M` to blocks indexed by `α`s. Then
`block_triangular M n b` says the matrix is block triangular. -/
def block_triangular (M : matrix m m R) (b : m → α) : Prop := ∀ ⦃i j⦄, b j < b i → M i j = 0

@[simp] protected lemma block_triangular.submatrix {f : n → m} (h : M.block_triangular b) :
  (M.submatrix f f).block_triangular (b ∘ f) :=
λ i j hij, h hij

lemma block_triangular_reindex_iff {b : n → α} {e : m ≃ n} :
  (reindex e e M).block_triangular b ↔ M.block_triangular (b ∘ e) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { convert h.submatrix,
    simp only [reindex_apply, submatrix_submatrix, submatrix_id_id, equiv.symm_comp_self] },
  { convert h.submatrix,
    simp only [comp.assoc b e e.symm, equiv.self_comp_symm, comp.right_id] }
end

protected lemma block_triangular.transpose :
  M.block_triangular b → Mᵀ.block_triangular (to_dual ∘ b) := swap

@[simp] protected lemma block_triangular_transpose_iff {b : m → αᵒᵈ} :
  Mᵀ.block_triangular b ↔ M.block_triangular (of_dual ∘ b) := forall_swap

@[simp] lemma block_triangular_zero : block_triangular (0 : matrix m m R) b := λ i j h, rfl

protected lemma block_triangular.neg (hM : block_triangular M b) : block_triangular (-M) b :=
λ i j h, neg_eq_zero.2 $ hM h

lemma block_triangular.add (hM : block_triangular M b) (hN : block_triangular N b) :
  block_triangular (M + N) b :=
λ i j h, by simp_rw [pi.add_apply, hM h, hN h, zero_add]

lemma block_triangular.sub (hM : block_triangular M b) (hN : block_triangular N b) :
  block_triangular (M - N) b :=
λ i j h, by simp_rw [pi.sub_apply, hM h, hN h, sub_zero]

end has_lt

section preorder
variables [preorder α]

lemma block_triangular_diagonal [decidable_eq m] (d : m → R) :
  block_triangular (diagonal d) b :=
λ i j h, diagonal_apply_ne' d (λ h', ne_of_lt h (congr_arg _ h'))

lemma block_triangular_block_diagonal' [decidable_eq α] (d : Π (i : α), matrix (m' i) (m' i) R) :
  block_triangular (block_diagonal' d) sigma.fst :=
begin
  rintros ⟨i, i'⟩ ⟨j, j'⟩ h,
  apply block_diagonal'_apply_ne d i' j' (λ h', ne_of_lt h h'.symm),
end

lemma block_triangular_block_diagonal [decidable_eq α] (d : α → matrix m m R) :
  block_triangular (block_diagonal d) prod.snd :=
begin
  rintros ⟨i, i'⟩ ⟨j, j'⟩ h,
  rw [block_diagonal'_eq_block_diagonal, block_triangular_block_diagonal'],
  exact h
end

end preorder

section linear_order
variables [linear_order α]

lemma block_triangular.mul [fintype m]
  {M N : matrix m m R} (hM : block_triangular M b) (hN : block_triangular N b):
  block_triangular (M * N) b :=
begin
  intros i j hij,
  apply finset.sum_eq_zero,
  intros k hk,
  by_cases hki : b k < b i,
  { simp_rw [hM hki, zero_mul] },
  { simp_rw [hN (lt_of_lt_of_le hij (le_of_not_lt hki)), mul_zero] },
end

end linear_order

lemma upper_two_block_triangular [preorder α]
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) {a b : α} (hab : a < b) :
  block_triangular (from_blocks A B 0 D) (sum.elim (λ i, a) (λ j, b)) :=
by rintro (c | c) (d | d) hcd; simpa [hab.not_lt] using hcd <|> simp

/-! ### Determinant -/

variables [decidable_eq m] [fintype m] [decidable_eq n] [fintype n]

lemma equiv_block_det (M : matrix m m R) {p q : m → Prop} [decidable_pred p] [decidable_pred q]
  (e : ∀ x, q x ↔ p x) : (to_square_block_prop M p).det = (to_square_block_prop M q).det :=
by convert matrix.det_reindex_self (equiv.subtype_equiv_right e) (to_square_block_prop M q)

@[simp] lemma det_to_square_block_id (M : matrix m m R) (i : m) :
  (M.to_square_block id i).det = M i i :=
begin
  letI : unique {a // id a = i} := ⟨⟨⟨i, rfl⟩⟩, λ j, subtype.ext j.property⟩,
  exact (det_unique _).trans rfl,
end

lemma det_to_block (M : matrix m m R) (p : m → Prop) [decidable_pred p] :
  M.det = (from_blocks (to_block M p p) (to_block M p $ λ j, ¬p j)
    (to_block M (λ j, ¬p j) p) $ to_block M (λ j, ¬p j) $ λ j, ¬p j).det :=
begin
  rw ←matrix.det_reindex_self (equiv.sum_compl p).symm M,
  rw [det_apply', det_apply'],
  congr, ext σ, congr, ext,
  generalize hy : σ x = y,
  cases x; cases y;
  simp only [matrix.reindex_apply, to_block_apply, equiv.symm_symm,
    equiv.sum_compl_apply_inr, equiv.sum_compl_apply_inl,
    from_blocks_apply₁₁, from_blocks_apply₁₂, from_blocks_apply₂₁, from_blocks_apply₂₂,
    matrix.submatrix_apply],
end

lemma two_block_triangular_det (M : matrix m m R) (p : m → Prop) [decidable_pred p]
  (h : ∀ i, ¬ p i → ∀ j, p j → M i j = 0) :
  M.det = (to_square_block_prop M p).det * (to_square_block_prop M (λ i, ¬p i)).det :=
begin
  rw det_to_block M p,
  convert det_from_blocks_zero₂₁ (to_block M p p) (to_block M p (λ j, ¬p j))
    (to_block M (λ j, ¬p j) (λ j, ¬p j)),
  ext,
  exact h ↑i i.2 ↑j j.2
end

lemma two_block_triangular_det' (M : matrix m m R) (p : m → Prop) [decidable_pred p]
  (h : ∀ i, p i → ∀ j, ¬ p j → M i j = 0) :
  M.det = (to_square_block_prop M p).det * (to_square_block_prop M (λ i, ¬p i)).det :=
begin
  rw [M.two_block_triangular_det (λ i, ¬ p i), mul_comm],
  simp_rw not_not,
  congr' 1,
  exact equiv_block_det _ (λ _, not_not.symm),
  simpa only [not_not] using h,
end

protected lemma block_triangular.det [decidable_eq α] [linear_order α] (hM : block_triangular M b) :
  M.det = ∏ a in univ.image b, (M.to_square_block b a).det :=
begin
  unfreezingI { induction hs : univ.image b using finset.strong_induction
    with s ih generalizing m },
  subst hs,
  casesI is_empty_or_nonempty m,
  { simp },
  let k := (univ.image b).max' (univ_nonempty.image _),
  rw two_block_triangular_det' M (λ i, b i = k),
  { have : univ.image b = insert k ((univ.image b).erase k),
    { rw insert_erase, apply max'_mem },
    rw [this, prod_insert (not_mem_erase _ _)],
    refine congr_arg _ _,
    let b' := λ i : {a // b a ≠ k}, b ↑i,
    have h' :  block_triangular (M.to_square_block_prop (λ i, b i ≠ k)) b' := hM.submatrix,
    have hb' : image b' univ = (image b univ).erase k,
    { convert image_subtype_ne_univ_eq_image_erase k b },
    rw ih _ (erase_ssubset $ max'_mem _ _) h' hb',
    refine finset.prod_congr rfl (λ l hl, _),
    let he : {a // b' a = l} ≃ {a // b a = l},
    { have hc : ∀ i, b i = l → b i ≠ k := λ i hi, ne_of_eq_of_ne hi (ne_of_mem_erase hl),
      exact equiv.subtype_subtype_equiv_subtype hc },
    simp only [to_square_block_def],
    rw ← matrix.det_reindex_self he.symm (λ (i j : {a // b a = l}), M ↑i ↑j),
    refl },
  { intros i hi j hj,
    apply hM,
    rw hi,
    apply lt_of_le_of_ne _ hj,
    exact finset.le_max' (univ.image b) _ (mem_image_of_mem _ (mem_univ _)) }
end

lemma block_triangular.det_fintype [decidable_eq α] [fintype α] [linear_order α]
  (h : block_triangular M b) :
  M.det = ∏ k : α, (M.to_square_block b k).det :=
begin
  refine h.det.trans (prod_subset (subset_univ _) $ λ a _ ha, _),
  have : is_empty {i // b i = a} := ⟨λ i, ha $ mem_image.2 ⟨i, mem_univ _, i.2⟩⟩,
  exactI det_is_empty,
end

lemma det_of_upper_triangular [linear_order m] (h : M.block_triangular id) :
  M.det = ∏ i : m, M i i :=
begin
  haveI : decidable_eq R := classical.dec_eq _,
  simp_rw [h.det, image_id, det_to_square_block_id],
end

lemma det_of_lower_triangular [linear_order m] (M : matrix m m R) (h : M.block_triangular to_dual) :
  M.det = ∏ i : m, M i i :=
by { rw ←det_transpose, exact det_of_upper_triangular h.transpose }

/-! ### Invertible -/

lemma block_triangular.to_block_inverse_mul_to_block_eq_one [linear_order α] [invertible M]
  (hM : block_triangular M b) (k : α) :
  M⁻¹.to_block (λ i, b i < k) (λ i, b i < k) ⬝ M.to_block (λ i, b i < k) (λ i, b i < k) = 1 :=
begin
  let p := (λ i, b i < k),
  have h_sum : M⁻¹.to_block p p ⬝ M.to_block p p +
      M⁻¹.to_block p (λ i, ¬ p i) ⬝ M.to_block (λ i, ¬ p i) p = 1,
    by rw [←to_block_mul_eq_add, inv_mul_of_invertible M, to_block_one_self],
  have h_zero : M.to_block (λ i, ¬ p i) p = 0,
  { ext i j,
    simpa using hM (lt_of_lt_of_le j.2 (le_of_not_lt i.2)) },
  simpa [h_zero] using h_sum
end

/-- The inverse of an upper-left subblock of a block-triangular matrix `M` is the upper-left
subblock of `M⁻¹`. -/
lemma block_triangular.inv_to_block [linear_order α] [invertible M]
  (hM : block_triangular M b) (k : α) :
  (M.to_block (λ i, b i < k) (λ i, b i < k))⁻¹ = M⁻¹.to_block (λ i, b i < k) (λ i, b i < k) :=
inv_eq_left_inv $ hM.to_block_inverse_mul_to_block_eq_one k

/-- An upper-left subblock of an invertible block-triangular matrix is invertible. -/
def block_triangular.invertible_to_block [linear_order α] [invertible M]
 (hM : block_triangular M b) (k : α) :
  invertible (M.to_block (λ i, b i < k) (λ i, b i < k)) :=
invertible_of_left_inverse _ ((⅟M).to_block (λ i, b i < k) (λ i, b i < k)) $
  by simpa only [inv_of_eq_nonsing_inv] using hM.to_block_inverse_mul_to_block_eq_one k

/-- A lower-left subblock of the inverse of a block-triangular matrix is zero. This is a first step
towards `block_triangular.inv_to_block` below. -/
lemma to_block_inverse_eq_zero [linear_order α] [invertible M] (hM : block_triangular M b) (k : α) :
  M⁻¹.to_block (λ i, k ≤ b i) (λ i, b i < k) = 0 :=
begin
  let p := λ i, b i < k,
  let q := λ i, ¬ b i < k,
  have h_sum : M⁻¹.to_block q p ⬝ M.to_block p p + M⁻¹.to_block q q ⬝ M.to_block q p = 0,
  { rw [←to_block_mul_eq_add, inv_mul_of_invertible M, to_block_one_disjoint],
    rw disjoint_iff_inf_le,
    exact λ i h, h.1 h.2 },
  have h_zero : M.to_block q p = 0,
  { ext i j,
    simpa using hM (lt_of_lt_of_le j.2 $ le_of_not_lt i.2) },
  have h_mul_eq_zero : M⁻¹.to_block q p ⬝ M.to_block p p = 0 := by simpa [h_zero] using h_sum,
  haveI : invertible (M.to_block p p) := hM.invertible_to_block k,
  have : (λ i, k ≤ b i) = q := by { ext, exact not_lt.symm },
  rw [this, ← matrix.zero_mul (M.to_block p p)⁻¹, ← h_mul_eq_zero,
    mul_inv_cancel_right_of_invertible],
end

/-- The inverse of a block-triangular matrix is block-triangular. -/
lemma block_triangular_inv_of_block_triangular [linear_order α] [invertible M]
  (hM : block_triangular M b) :
  block_triangular M⁻¹ b :=
begin
  unfreezingI { induction hs : univ.image b using finset.strong_induction
    with s ih generalizing m },
  subst hs,
  intros i j hij,
  haveI : inhabited m := ⟨i⟩,
  let k := (univ.image b).max' (univ_nonempty.image _),
  let b' := λ i : {a // b a < k}, b ↑i,
  let A := M.to_block (λ i, b i < k) (λ j, b j < k),
  obtain hbi | hi : b i = k ∨ _ := (le_max' _ (b i) $ mem_image_of_mem _ $ mem_univ _).eq_or_lt,
  { have : M⁻¹.to_block (λ i, k ≤ b i) (λ i, b i < k) ⟨i, hbi.ge⟩ ⟨j, hbi ▸ hij⟩ = 0,
    { simp only [to_block_inverse_eq_zero hM k, pi.zero_apply] },
    simp [this.symm] },
  haveI : invertible A := hM.invertible_to_block _,
  have hA : A.block_triangular b' := hM.submatrix,
  have hb' : image b' univ ⊂ image b univ,
  { convert image_subtype_univ_ssubset_image_univ k b _ (λ a, a < k) (lt_irrefl _),
    convert max'_mem _ _ },
  have hij' : b' ⟨j, hij.trans hi⟩ < b' ⟨i, hi⟩, by simp_rw [b', subtype.coe_mk, hij],
  simp [hM.inv_to_block k, (ih (image b' univ) hb' hA rfl hij').symm],
end

end matrix


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Johannes Hölzl, Yury G. Kudryashov, Patrick Massot
-/
import algebra.geom_sum
import order.filter.archimedean
import order.iterate
import topology.instances.ennreal
import topology.algebra.algebra

/-!
# A collection of specific limit computations

This file, by design, is independent of `normed_space` in the import hierarchy.  It contains
important specific limit computations in metric spaces, in ordered rings/fields, and in specific
instances of these such as `ℝ`, `ℝ≥0` and `ℝ≥0∞`.
-/

noncomputable theory
open classical set function filter finset metric

open_locale classical topology nat big_operators uniformity nnreal ennreal

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

lemma tendsto_inverse_at_top_nhds_0_nat : tendsto (λ n : ℕ, (n : ℝ)⁻¹) at_top (𝓝 0) :=
tendsto_inv_at_top_zero.comp tendsto_coe_nat_at_top_at_top

lemma tendsto_const_div_at_top_nhds_0_nat (C : ℝ) : tendsto (λ n : ℕ, C / n) at_top (𝓝 0) :=
by simpa only [mul_zero] using tendsto_const_nhds.mul tendsto_inverse_at_top_nhds_0_nat

lemma nnreal.tendsto_inverse_at_top_nhds_0_nat : tendsto (λ n : ℕ, (n : ℝ≥0)⁻¹) at_top (𝓝 0) :=
by { rw ← nnreal.tendsto_coe, exact tendsto_inverse_at_top_nhds_0_nat }

lemma nnreal.tendsto_const_div_at_top_nhds_0_nat (C : ℝ≥0) :
  tendsto (λ n : ℕ, C / n) at_top (𝓝 0) :=
by simpa using tendsto_const_nhds.mul nnreal.tendsto_inverse_at_top_nhds_0_nat

lemma tendsto_one_div_add_at_top_nhds_0_nat :
  tendsto (λ n : ℕ, 1 / ((n : ℝ) + 1)) at_top (𝓝 0) :=
suffices tendsto (λ n : ℕ, 1 / (↑(n + 1) : ℝ)) at_top (𝓝 0), by simpa,
(tendsto_add_at_top_iff_nat 1).2 (tendsto_const_div_at_top_nhds_0_nat 1)

/-- The limit of `n / (n + x)` is 1, for any constant `x` (valid in `ℝ` or any topological division
algebra over `ℝ`, e.g., `ℂ`).

TODO: introduce a typeclass saying that `1 / n` tends to 0 at top, making it possible to get this
statement simultaneously on `ℚ`, `ℝ` and `ℂ`. -/
lemma tendsto_coe_nat_div_add_at_top
  {𝕜 : Type*} [division_ring 𝕜] [topological_space 𝕜] [char_zero 𝕜] [algebra ℝ 𝕜]
  [has_continuous_smul ℝ 𝕜] [topological_division_ring 𝕜]
  (x : 𝕜) :
  tendsto (λ n:ℕ, (n:𝕜) / (n + x)) at_top (𝓝 1) :=
begin
  refine tendsto.congr' ((eventually_ne_at_top 0).mp (eventually_of_forall (λ n hn, _))) _,
  { exact λ n:ℕ, 1 / (1 + x / n) },
  { field_simp [nat.cast_ne_zero.mpr hn] },
  { have : 𝓝 (1:𝕜) = 𝓝 (1 / (1 + x * ↑(0:ℝ))),
    by rw [algebra_map.coe_zero, mul_zero, add_zero, div_one],
    rw this,
    refine tendsto_const_nhds.div (tendsto_const_nhds.add _) (by simp),
    simp_rw div_eq_mul_inv,
    refine (tendsto_const_nhds.mul _),
    have : (λ n : ℕ, (n : 𝕜)⁻¹) = (λ n : ℕ, ↑((n : ℝ)⁻¹)),
    { ext1 n,
      rw [←(map_nat_cast (algebra_map ℝ 𝕜) n), ←map_inv₀ (algebra_map ℝ 𝕜)],
      refl, },
    rw this,
    exact ((continuous_algebra_map ℝ 𝕜).tendsto _).comp tendsto_inverse_at_top_nhds_0_nat }
end

/-! ### Powers -/

lemma tendsto_add_one_pow_at_top_at_top_of_pos [linear_ordered_semiring α] [archimedean α] {r : α}
  (h : 0 < r) :
  tendsto (λ n:ℕ, (r + 1)^n) at_top at_top :=
tendsto_at_top_at_top_of_monotone' (λ n m, pow_le_pow (le_add_of_nonneg_left (le_of_lt h))) $
  not_bdd_above_iff.2 $ λ x, set.exists_range_iff.2 $ add_one_pow_unbounded_of_pos _ h

lemma tendsto_pow_at_top_at_top_of_one_lt [linear_ordered_ring α] [archimedean α]
  {r : α} (h : 1 < r) :
  tendsto (λn:ℕ, r ^ n) at_top at_top :=
sub_add_cancel r 1 ▸ tendsto_add_one_pow_at_top_at_top_of_pos (sub_pos.2 h)

lemma nat.tendsto_pow_at_top_at_top_of_one_lt {m : ℕ} (h : 1 < m) :
  tendsto (λn:ℕ, m ^ n) at_top at_top :=
tsub_add_cancel_of_le (le_of_lt h) ▸
  tendsto_add_one_pow_at_top_at_top_of_pos (tsub_pos_of_lt h)

lemma tendsto_pow_at_top_nhds_0_of_lt_1 {𝕜 : Type*} [linear_ordered_field 𝕜] [archimedean 𝕜]
  [topological_space 𝕜] [order_topology 𝕜] {r : 𝕜} (h₁ : 0 ≤ r) (h₂ : r < 1) :
  tendsto (λn:ℕ, r^n) at_top (𝓝 0) :=
h₁.eq_or_lt.elim
  (assume : 0 = r,
    (tendsto_add_at_top_iff_nat 1).mp $ by simp [pow_succ, ← this, tendsto_const_nhds])
  (assume : 0 < r,
    have tendsto (λn, (r⁻¹ ^ n)⁻¹) at_top (𝓝 0),
      from tendsto_inv_at_top_zero.comp
        (tendsto_pow_at_top_at_top_of_one_lt $ one_lt_inv this h₂),
    this.congr (λ n, by simp))

lemma tendsto_pow_at_top_nhds_within_0_of_lt_1 {𝕜 : Type*} [linear_ordered_field 𝕜] [archimedean 𝕜]
  [topological_space 𝕜] [order_topology 𝕜] {r : 𝕜} (h₁ : 0 < r) (h₂ : r < 1) :
  tendsto (λn:ℕ, r^n) at_top (𝓝[>] 0) :=
tendsto_inf.2 ⟨tendsto_pow_at_top_nhds_0_of_lt_1 h₁.le h₂,
  tendsto_principal.2 $ eventually_of_forall $ λ n, pow_pos h₁ _⟩

lemma uniformity_basis_dist_pow_of_lt_1 {α : Type*} [pseudo_metric_space α]
  {r : ℝ} (h₀ : 0 < r) (h₁ : r < 1) :
  (𝓤 α).has_basis (λ k : ℕ, true) (λ k, {p : α × α | dist p.1 p.2 < r ^ k}) :=
metric.mk_uniformity_basis (λ i _, pow_pos h₀ _) $ λ ε ε0,
  (exists_pow_lt_of_lt_one ε0 h₁).imp $ λ k hk, ⟨trivial, hk.le⟩

lemma geom_lt {u : ℕ → ℝ} {c : ℝ} (hc : 0 ≤ c) {n : ℕ} (hn : 0 < n)
  (h : ∀ k < n, c * u k < u (k + 1)) :
  c ^ n * u 0 < u n :=
begin
  refine (monotone_mul_left_of_nonneg hc).seq_pos_lt_seq_of_le_of_lt hn _ _ h,
  { simp },
  { simp [pow_succ, mul_assoc, le_refl] }
end

lemma geom_le {u : ℕ → ℝ} {c : ℝ} (hc : 0 ≤ c) (n : ℕ) (h : ∀ k < n, c * u k ≤ u (k + 1)) :
  c ^ n * u 0 ≤ u n :=
by refine (monotone_mul_left_of_nonneg hc).seq_le_seq n _ _ h; simp [pow_succ, mul_assoc, le_refl]

lemma lt_geom {u : ℕ → ℝ} {c : ℝ} (hc : 0 ≤ c) {n : ℕ} (hn : 0 < n)
  (h : ∀ k < n, u (k + 1) < c * u k) :
  u n < c ^ n * u 0 :=
begin
  refine (monotone_mul_left_of_nonneg hc).seq_pos_lt_seq_of_lt_of_le hn _ h _,
  { simp },
  { simp [pow_succ, mul_assoc, le_refl] }
end

lemma le_geom {u : ℕ → ℝ} {c : ℝ} (hc : 0 ≤ c) (n : ℕ) (h : ∀ k < n, u (k + 1) ≤ c * u k) :
  u n ≤ (c ^ n) * u 0 :=
by refine (monotone_mul_left_of_nonneg hc).seq_le_seq n _ h _; simp [pow_succ, mul_assoc, le_refl]

/-- If a sequence `v` of real numbers satisfies `k * v n ≤ v (n+1)` with `1 < k`,
then it goes to +∞. -/
lemma tendsto_at_top_of_geom_le {v : ℕ → ℝ} {c : ℝ} (h₀ : 0 < v 0) (hc : 1 < c)
  (hu : ∀ n, c * v n ≤ v (n + 1)) : tendsto v at_top at_top :=
tendsto_at_top_mono (λ n, geom_le (zero_le_one.trans hc.le) n (λ k hk, hu k)) $
  (tendsto_pow_at_top_at_top_of_one_lt hc).at_top_mul_const h₀

lemma nnreal.tendsto_pow_at_top_nhds_0_of_lt_1 {r : ℝ≥0} (hr : r < 1) :
  tendsto (λ n:ℕ, r^n) at_top (𝓝 0) :=
nnreal.tendsto_coe.1 $ by simp only [nnreal.coe_pow, nnreal.coe_zero,
  tendsto_pow_at_top_nhds_0_of_lt_1 r.coe_nonneg hr]

lemma ennreal.tendsto_pow_at_top_nhds_0_of_lt_1 {r : ℝ≥0∞} (hr : r < 1) :
  tendsto (λ n:ℕ, r^n) at_top (𝓝 0) :=
begin
  rcases ennreal.lt_iff_exists_coe.1 hr with ⟨r, rfl, hr'⟩,
  rw [← ennreal.coe_zero],
  norm_cast at *,
  apply nnreal.tendsto_pow_at_top_nhds_0_of_lt_1 hr
end

/-! ### Geometric series-/
section geometric

lemma has_sum_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) :
  has_sum (λn:ℕ, r ^ n) (1 - r)⁻¹ :=
have r ≠ 1, from ne_of_lt h₂,
have tendsto (λn, (r ^ n - 1) * (r - 1)⁻¹) at_top (𝓝 ((0 - 1) * (r - 1)⁻¹)),
  from ((tendsto_pow_at_top_nhds_0_of_lt_1 h₁ h₂).sub tendsto_const_nhds).mul tendsto_const_nhds,
(has_sum_iff_tendsto_nat_of_nonneg (pow_nonneg h₁) _).mpr $
  by simp [neg_inv, geom_sum_eq, div_eq_mul_inv, *] at *

lemma summable_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) : summable (λn:ℕ, r ^ n) :=
⟨_, has_sum_geometric_of_lt_1 h₁ h₂⟩

lemma tsum_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) : ∑'n:ℕ, r ^ n = (1 - r)⁻¹ :=
(has_sum_geometric_of_lt_1 h₁ h₂).tsum_eq

lemma has_sum_geometric_two : has_sum (λn:ℕ, ((1:ℝ)/2) ^ n) 2 :=
by convert has_sum_geometric_of_lt_1 _ _; norm_num

lemma summable_geometric_two : summable (λn:ℕ, ((1:ℝ)/2) ^ n) :=
⟨_, has_sum_geometric_two⟩

lemma summable_geometric_two_encode {ι : Type*} [encodable ι] :
  summable (λ (i : ι), (1/2 : ℝ)^(encodable.encode i)) :=
summable_geometric_two.comp_injective encodable.encode_injective

lemma tsum_geometric_two : ∑'n:ℕ, ((1:ℝ)/2) ^ n = 2 :=
has_sum_geometric_two.tsum_eq

lemma sum_geometric_two_le (n : ℕ) : ∑ (i : ℕ) in range n, (1 / (2 : ℝ)) ^ i ≤ 2 :=
begin
  have : ∀ i, 0 ≤ (1 / (2 : ℝ)) ^ i,
  { intro i, apply pow_nonneg, norm_num },
  convert sum_le_tsum (range n) (λ i _, this i) summable_geometric_two,
  exact tsum_geometric_two.symm
end

lemma tsum_geometric_inv_two : ∑' n : ℕ, (2 : ℝ)⁻¹ ^ n = 2 :=
(inv_eq_one_div (2 : ℝ)).symm ▸ tsum_geometric_two

/-- The sum of `2⁻¹ ^ i` for `n ≤ i` equals `2 * 2⁻¹ ^ n`. -/
lemma tsum_geometric_inv_two_ge (n : ℕ) :
  ∑' i, ite (n ≤ i) ((2 : ℝ)⁻¹ ^ i) 0 = 2 * 2⁻¹ ^ n :=
begin
  have A : summable (λ (i : ℕ), ite (n ≤ i) ((2⁻¹ : ℝ) ^ i) 0),
  { apply summable_of_nonneg_of_le _ _ summable_geometric_two;
    { intro i, by_cases hi : n ≤ i; simp [hi] } },
  have B : (finset.range n).sum (λ (i : ℕ), ite (n ≤ i) ((2⁻¹ : ℝ)^i) 0) = 0 :=
    finset.sum_eq_zero (λ i hi, ite_eq_right_iff.2 $ λ h,
      (lt_irrefl _ ((finset.mem_range.1 hi).trans_le h)).elim),
  simp only [← sum_add_tsum_nat_add n A, B, if_true, zero_add, zero_le',
    le_add_iff_nonneg_left, pow_add, tsum_mul_right, tsum_geometric_inv_two],
end

lemma has_sum_geometric_two' (a : ℝ) : has_sum (λn:ℕ, (a / 2) / 2 ^ n) a :=
begin
  convert has_sum.mul_left (a / 2) (has_sum_geometric_of_lt_1
    (le_of_lt one_half_pos) one_half_lt_one),
  { funext n, simp, refl, },
  { norm_num }
end

lemma summable_geometric_two' (a : ℝ) : summable (λ n:ℕ, (a / 2) / 2 ^ n) :=
⟨a, has_sum_geometric_two' a⟩

lemma tsum_geometric_two' (a : ℝ) : ∑' n:ℕ, (a / 2) / 2^n = a :=
(has_sum_geometric_two' a).tsum_eq

/-- **Sum of a Geometric Series** -/
lemma nnreal.has_sum_geometric {r : ℝ≥0} (hr : r < 1) :
  has_sum (λ n : ℕ, r ^ n) (1 - r)⁻¹ :=
begin
  apply nnreal.has_sum_coe.1,
  push_cast,
  rw [nnreal.coe_sub (le_of_lt hr)],
  exact has_sum_geometric_of_lt_1 r.coe_nonneg hr
end

lemma nnreal.summable_geometric {r : ℝ≥0} (hr : r < 1) : summable (λn:ℕ, r ^ n) :=
⟨_, nnreal.has_sum_geometric hr⟩

lemma tsum_geometric_nnreal {r : ℝ≥0} (hr : r < 1) : ∑'n:ℕ, r ^ n = (1 - r)⁻¹ :=
(nnreal.has_sum_geometric hr).tsum_eq

/-- The series `pow r` converges to `(1-r)⁻¹`. For `r < 1` the RHS is a finite number,
and for `1 ≤ r` the RHS equals `∞`. -/
@[simp] lemma ennreal.tsum_geometric (r : ℝ≥0∞) : ∑'n:ℕ, r ^ n = (1 - r)⁻¹ :=
begin
  cases lt_or_le r 1 with hr hr,
  { rcases ennreal.lt_iff_exists_coe.1 hr with ⟨r, rfl, hr'⟩,
    norm_cast at *,
    convert ennreal.tsum_coe_eq (nnreal.has_sum_geometric hr),
    rw [ennreal.coe_inv $ ne_of_gt $ tsub_pos_iff_lt.2 hr] },
  { rw [tsub_eq_zero_iff_le.mpr hr, ennreal.inv_zero, ennreal.tsum_eq_supr_nat, supr_eq_top],
    refine λ a ha, (ennreal.exists_nat_gt (lt_top_iff_ne_top.1 ha)).imp
      (λ n hn, lt_of_lt_of_le hn _),
    calc (n:ℝ≥0∞) = ∑ i in range n, 1     : by rw [sum_const, nsmul_one, card_range]
              ... ≤ ∑ i in range n, r ^ i : sum_le_sum (λ k _, one_le_pow_of_one_le' hr k) }
end

end geometric

/-!
### Sequences with geometrically decaying distance in metric spaces

In this paragraph, we discuss sequences in metric spaces or emetric spaces for which the distance
between two consecutive terms decays geometrically. We show that such sequences are Cauchy
sequences, and bound their distances to the limit. We also discuss series with geometrically
decaying terms.
-/
section edist_le_geometric

variables [pseudo_emetric_space α] (r C : ℝ≥0∞) (hr : r < 1) (hC : C ≠ ⊤) {f : ℕ → α}
  (hu : ∀n, edist (f n) (f (n+1)) ≤ C * r^n)

include hr hC hu

/-- If `edist (f n) (f (n+1))` is bounded by `C * r^n`, `C ≠ ∞`, `r < 1`,
then `f` is a Cauchy sequence.-/
lemma cauchy_seq_of_edist_le_geometric : cauchy_seq f :=
begin
  refine cauchy_seq_of_edist_le_of_tsum_ne_top _ hu _,
  rw [ennreal.tsum_mul_left, ennreal.tsum_geometric],
  refine ennreal.mul_ne_top hC (ennreal.inv_ne_top.2 _),
  exact (tsub_pos_iff_lt.2 hr).ne'
end

omit hr hC

/-- If `edist (f n) (f (n+1))` is bounded by `C * r^n`, then the distance from
`f n` to the limit of `f` is bounded above by `C * r^n / (1 - r)`. -/
lemma edist_le_of_edist_le_geometric_of_tendsto {a : α} (ha : tendsto f at_top (𝓝 a)) (n : ℕ) :
  edist (f n) a ≤ (C * r^n) / (1 - r) :=
begin
  convert edist_le_tsum_of_edist_le_of_tendsto _ hu ha _,
  simp only [pow_add, ennreal.tsum_mul_left, ennreal.tsum_geometric, div_eq_mul_inv, mul_assoc]
end

/-- If `edist (f n) (f (n+1))` is bounded by `C * r^n`, then the distance from
`f 0` to the limit of `f` is bounded above by `C / (1 - r)`. -/
lemma edist_le_of_edist_le_geometric_of_tendsto₀ {a : α} (ha : tendsto f at_top (𝓝 a)) :
  edist (f 0) a ≤ C / (1 - r) :=
by simpa only [pow_zero, mul_one] using edist_le_of_edist_le_geometric_of_tendsto r C hu ha 0

end edist_le_geometric

section edist_le_geometric_two

variables [pseudo_emetric_space α] (C : ℝ≥0∞) (hC : C ≠ ⊤) {f : ℕ → α}
  (hu : ∀n, edist (f n) (f (n+1)) ≤ C / 2^n) {a : α} (ha : tendsto f at_top (𝓝 a))

include hC hu

/-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then `f` is a Cauchy sequence.-/
lemma cauchy_seq_of_edist_le_geometric_two : cauchy_seq f :=
begin
  simp only [div_eq_mul_inv, ennreal.inv_pow] at hu,
  refine cauchy_seq_of_edist_le_geometric 2⁻¹ C _ hC hu,
  simp [ennreal.one_lt_two]
end

omit hC
include ha

/-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then the distance from
`f n` to the limit of `f` is bounded above by `2 * C * 2^-n`. -/
lemma edist_le_of_edist_le_geometric_two_of_tendsto (n : ℕ) :
  edist (f n) a ≤ 2 * C / 2^n :=
begin
  simp only [div_eq_mul_inv, ennreal.inv_pow] at *,
  rw [mul_assoc, mul_comm],
  convert edist_le_of_edist_le_geometric_of_tendsto 2⁻¹ C hu ha n,
  rw [ennreal.one_sub_inv_two, inv_inv]
end

/-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then the distance from
`f 0` to the limit of `f` is bounded above by `2 * C`. -/
lemma edist_le_of_edist_le_geometric_two_of_tendsto₀: edist (f 0) a ≤ 2 * C :=
by simpa only [pow_zero, div_eq_mul_inv, inv_one, mul_one]
  using edist_le_of_edist_le_geometric_two_of_tendsto C hu ha 0

end edist_le_geometric_two

section le_geometric

variables [pseudo_metric_space α] {r C : ℝ} (hr : r < 1) {f : ℕ → α}
  (hu : ∀n, dist (f n) (f (n+1)) ≤ C * r^n)

include hr hu

lemma aux_has_sum_of_le_geometric : has_sum (λ n : ℕ, C * r^n) (C / (1 - r)) :=
begin
  rcases sign_cases_of_C_mul_pow_nonneg (λ n, dist_nonneg.trans (hu n)) with rfl | ⟨C₀, r₀⟩,
  { simp [has_sum_zero] },
  { refine has_sum.mul_left C _,
    simpa using has_sum_geometric_of_lt_1 r₀ hr }
end

variables (r C)

/-- If `dist (f n) (f (n+1))` is bounded by `C * r^n`, `r < 1`, then `f` is a Cauchy sequence.
Note that this lemma does not assume `0 ≤ C` or `0 ≤ r`. -/
lemma cauchy_seq_of_le_geometric : cauchy_seq f :=
cauchy_seq_of_dist_le_of_summable _ hu ⟨_, aux_has_sum_of_le_geometric hr hu⟩

/-- If `dist (f n) (f (n+1))` is bounded by `C * r^n`, `r < 1`, then the distance from
`f n` to the limit of `f` is bounded above by `C * r^n / (1 - r)`. -/
lemma dist_le_of_le_geometric_of_tendsto₀ {a : α} (ha : tendsto f at_top (𝓝 a)) :
  dist (f 0) a ≤ C / (1 - r) :=
(aux_has_sum_of_le_geometric hr hu).tsum_eq ▸
  dist_le_tsum_of_dist_le_of_tendsto₀ _ hu ⟨_, aux_has_sum_of_le_geometric hr hu⟩ ha

/-- If `dist (f n) (f (n+1))` is bounded by `C * r^n`, `r < 1`, then the distance from
`f 0` to the limit of `f` is bounded above by `C / (1 - r)`. -/
lemma dist_le_of_le_geometric_of_tendsto {a : α} (ha : tendsto f at_top (𝓝 a)) (n : ℕ) :
  dist (f n) a ≤ (C * r^n) / (1 - r) :=
begin
  have := aux_has_sum_of_le_geometric hr hu,
  convert dist_le_tsum_of_dist_le_of_tendsto _ hu ⟨_, this⟩ ha n,
  simp only [pow_add, mul_left_comm C, mul_div_right_comm],
  rw [mul_comm],
  exact (this.mul_left _).tsum_eq.symm
end

omit hr hu

variable (hu₂ : ∀ n, dist (f n) (f (n+1)) ≤ (C / 2) / 2^n)

/-- If `dist (f n) (f (n+1))` is bounded by `(C / 2) / 2^n`, then `f` is a Cauchy sequence. -/
lemma cauchy_seq_of_le_geometric_two : cauchy_seq f :=
cauchy_seq_of_dist_le_of_summable _ hu₂ $ ⟨_, has_sum_geometric_two' C⟩

/-- If `dist (f n) (f (n+1))` is bounded by `(C / 2) / 2^n`, then the distance from
`f 0` to the limit of `f` is bounded above by `C`. -/
lemma dist_le_of_le_geometric_two_of_tendsto₀ {a : α} (ha : tendsto f at_top (𝓝 a)) :
  dist (f 0) a ≤ C :=
(tsum_geometric_two' C) ▸ dist_le_tsum_of_dist_le_of_tendsto₀ _ hu₂ (summable_geometric_two' C) ha

include hu₂

/-- If `dist (f n) (f (n+1))` is bounded by `(C / 2) / 2^n`, then the distance from
`f n` to the limit of `f` is bounded above by `C / 2^n`. -/
lemma dist_le_of_le_geometric_two_of_tendsto {a : α} (ha : tendsto f at_top (𝓝 a)) (n : ℕ) :
  dist (f n) a ≤ C / 2^n :=
begin
  convert dist_le_tsum_of_dist_le_of_tendsto _ hu₂ (summable_geometric_two' C) ha n,
  simp only [add_comm n, pow_add, ← div_div],
  symmetry,
  exact ((has_sum_geometric_two' C).div_const _).tsum_eq
end

end le_geometric

/-! ### Summability tests based on comparison with geometric series -/

/-- A series whose terms are bounded by the terms of a converging geometric series converges. -/
lemma summable_one_div_pow_of_le {m : ℝ} {f : ℕ → ℕ} (hm : 1 < m) (fi : ∀ i, i ≤ f i) :
  summable (λ i, 1 / m ^ f i) :=
begin
  refine summable_of_nonneg_of_le
    (λ a, one_div_nonneg.mpr (pow_nonneg (zero_le_one.trans hm.le) _)) (λ a, _)
    (summable_geometric_of_lt_1 (one_div_nonneg.mpr (zero_le_one.trans hm.le))
      ((one_div_lt (zero_lt_one.trans hm) zero_lt_one).mpr (one_div_one.le.trans_lt hm))),
  rw [div_pow, one_pow],
  refine (one_div_le_one_div _ _).mpr (pow_le_pow hm.le (fi a));
  exact pow_pos (zero_lt_one.trans hm) _
end

/-! ### Positive sequences with small sums on countable types -/

/-- For any positive `ε`, define on an encodable type a positive sequence with sum less than `ε` -/
def pos_sum_of_encodable {ε : ℝ} (hε : 0 < ε)
  (ι) [encodable ι] : {ε' : ι → ℝ // (∀ i, 0 < ε' i) ∧ ∃ c, has_sum ε' c ∧ c ≤ ε} :=
begin
  let f := λ n, (ε / 2) / 2 ^ n,
  have hf : has_sum f ε := has_sum_geometric_two' _,
  have f0 : ∀ n, 0 < f n := λ n, div_pos (half_pos hε) (pow_pos zero_lt_two _),
  refine ⟨f ∘ encodable.encode, λ i, f0 _, _⟩,
  rcases hf.summable.comp_injective (@encodable.encode_injective ι _) with ⟨c, hg⟩,
  refine ⟨c, hg, has_sum_le_inj _ (@encodable.encode_injective ι _) _ _ hg hf⟩,
  { assume i _, exact le_of_lt (f0 _) },
  { assume n, exact le_rfl }
end

lemma set.countable.exists_pos_has_sum_le {ι : Type*} {s : set ι} (hs : s.countable)
  {ε : ℝ} (hε : 0 < ε) :
  ∃ ε' : ι → ℝ, (∀ i, 0 < ε' i) ∧ ∃ c, has_sum (λ i : s, ε' i) c ∧ c ≤ ε :=
begin
  haveI := hs.to_encodable,
  rcases pos_sum_of_encodable hε s with ⟨f, hf0, ⟨c, hfc, hcε⟩⟩,
  refine ⟨λ i, if h : i ∈ s then f ⟨i, h⟩ else 1, λ i, _, ⟨c, _, hcε⟩⟩,
  { split_ifs, exacts [hf0 _, zero_lt_one] },
  { simpa only [subtype.coe_prop, dif_pos, subtype.coe_eta] }
end

lemma set.countable.exists_pos_forall_sum_le {ι : Type*} {s : set ι} (hs : s.countable)
  {ε : ℝ} (hε : 0 < ε) :
  ∃ ε' : ι → ℝ, (∀ i, 0 < ε' i) ∧ ∀ t : finset ι, ↑t ⊆ s → ∑ i in t, ε' i ≤ ε :=
begin
  rcases hs.exists_pos_has_sum_le hε with ⟨ε', hpos, c, hε'c, hcε⟩,
  refine ⟨ε', hpos, λ t ht, _⟩,
  rw [← sum_subtype_of_mem _ ht],
  refine (sum_le_has_sum _ _ hε'c).trans hcε,
  exact λ _ _, (hpos _).le
end

namespace nnreal

theorem exists_pos_sum_of_countable {ε : ℝ≥0} (hε : ε ≠ 0) (ι) [countable ι] :
  ∃ ε' : ι → ℝ≥0, (∀ i, 0 < ε' i) ∧ ∃c, has_sum ε' c ∧ c < ε :=
begin
  casesI nonempty_encodable ι,
  obtain ⟨a, a0, aε⟩ := exists_between (pos_iff_ne_zero.2 hε),
  obtain ⟨ε', hε', c, hc, hcε⟩ := pos_sum_of_encodable a0 ι,
  exact ⟨λ i, ⟨ε' i, (hε' i).le⟩, λ i, nnreal.coe_lt_coe.1 $ hε' i, ⟨c, has_sum_le (λ i, (hε' i).le)
    has_sum_zero hc⟩, nnreal.has_sum_coe.1 hc, aε.trans_le' $ nnreal.coe_le_coe.1 hcε⟩,
end

end nnreal

namespace ennreal

theorem exists_pos_sum_of_countable {ε : ℝ≥0∞} (hε : ε ≠ 0) (ι) [countable ι] :
  ∃ ε' : ι → ℝ≥0, (∀ i, 0 < ε' i) ∧ ∑' i, (ε' i : ℝ≥0∞) < ε :=
begin
  rcases exists_between (pos_iff_ne_zero.2 hε) with ⟨r, h0r, hrε⟩,
  rcases lt_iff_exists_coe.1 hrε with ⟨x, rfl, hx⟩,
  rcases nnreal.exists_pos_sum_of_countable (coe_pos.1 h0r).ne' ι with ⟨ε', hp, c, hc, hcr⟩,
  exact ⟨ε', hp, (ennreal.tsum_coe_eq hc).symm ▸ lt_trans (coe_lt_coe.2 hcr) hrε⟩
end

theorem exists_pos_tsum_mul_lt_of_countable {ε : ℝ≥0∞} (hε : ε ≠ 0) {ι} [countable ι]
  (w : ι → ℝ≥0∞) (hw : ∀ i, w i ≠ ∞) :
  ∃ δ : ι → ℝ≥0, (∀ i, 0 < δ i) ∧ ∑' i, (w i * δ i : ℝ≥0∞) < ε :=
begin
  lift w to ι → ℝ≥0 using hw,
  rcases exists_pos_sum_of_countable hε ι with ⟨δ', Hpos, Hsum⟩,
  have : ∀ i, 0 < max 1 (w i), from λ i, zero_lt_one.trans_le (le_max_left _ _),
  refine ⟨λ i, δ' i / max 1 (w i), λ i, div_pos (Hpos _) (this i), _⟩,
  refine lt_of_le_of_lt (ennreal.tsum_le_tsum $ λ i, _) Hsum,
  rw [coe_div (this i).ne'],
  refine mul_le_of_le_div' (mul_le_mul_left' (ennreal.inv_le_inv.2 _) _),
  exact coe_le_coe.2 (le_max_right _ _)
end

end ennreal

/-!
### Factorial
-/

lemma factorial_tendsto_at_top : tendsto nat.factorial at_top at_top :=
tendsto_at_top_at_top_of_monotone nat.monotone_factorial (λ n, ⟨n, n.self_le_factorial⟩)

lemma tendsto_factorial_div_pow_self_at_top : tendsto (λ n, n! / n^n : ℕ → ℝ) at_top (𝓝 0) :=
tendsto_of_tendsto_of_tendsto_of_le_of_le'
  tendsto_const_nhds
  (tendsto_const_div_at_top_nhds_0_nat 1)
  (eventually_of_forall $ λ n, div_nonneg (by exact_mod_cast n.factorial_pos.le)
    (pow_nonneg (by exact_mod_cast n.zero_le) _))
  begin
    refine (eventually_gt_at_top 0).mono (λ n hn, _),
    rcases nat.exists_eq_succ_of_ne_zero hn.ne.symm with ⟨k, rfl⟩,
    rw [← prod_range_add_one_eq_factorial, pow_eq_prod_const, div_eq_mul_inv, ← inv_eq_one_div,
      prod_nat_cast, nat.cast_succ, ← prod_inv_distrib, ← prod_mul_distrib,
      finset.prod_range_succ'],
    simp only [prod_range_succ', one_mul, nat.cast_add, zero_add, nat.cast_one],
    refine mul_le_of_le_one_left (inv_nonneg.mpr $ by exact_mod_cast hn.le) (prod_le_one _ _);
      intros x hx; rw finset.mem_range at hx,
    { refine mul_nonneg _ (inv_nonneg.mpr _); norm_cast; linarith },
    { refine (div_le_one $ by exact_mod_cast hn).mpr _, norm_cast, linarith }
  end

/-!
### Ceil and floor
-/

section

lemma tendsto_nat_floor_at_top {α : Type*} [linear_ordered_semiring α] [floor_semiring α] :
  tendsto (λ (x : α), ⌊x⌋₊) at_top at_top :=
nat.floor_mono.tendsto_at_top_at_top (λ x, ⟨max 0 (x + 1), by simp [nat.le_floor_iff]⟩)

variables {R : Type*} [topological_space R] [linear_ordered_field R] [order_topology R]
[floor_ring R]

lemma tendsto_nat_floor_mul_div_at_top {a : R} (ha : 0 ≤ a) :
  tendsto (λ x, (⌊a * x⌋₊ : R) / x) at_top (𝓝 a) :=
begin
  have A : tendsto (λ (x : R), a - x⁻¹) at_top (𝓝 (a - 0)) :=
    tendsto_const_nhds.sub tendsto_inv_at_top_zero,
  rw sub_zero at A,
  apply tendsto_of_tendsto_of_tendsto_of_le_of_le' A tendsto_const_nhds,
  { refine eventually_at_top.2 ⟨1, λ x hx, _⟩,
    simp only [le_div_iff (zero_lt_one.trans_le hx), sub_mul,
      inv_mul_cancel (zero_lt_one.trans_le hx).ne'],
    have := nat.lt_floor_add_one (a * x),
    linarith },
  { refine eventually_at_top.2 ⟨1, λ x hx, _⟩,
    rw div_le_iff (zero_lt_one.trans_le hx),
    simp [nat.floor_le (mul_nonneg ha (zero_le_one.trans hx))] }
end

lemma tendsto_nat_floor_div_at_top :
  tendsto (λ x, (⌊x⌋₊ : R) / x) at_top (𝓝 1) :=
by simpa using tendsto_nat_floor_mul_div_at_top (zero_le_one' R)

lemma tendsto_nat_ceil_mul_div_at_top {a : R} (ha : 0 ≤ a) :
  tendsto (λ x, (⌈a * x⌉₊ : R) / x) at_top (𝓝 a) :=
begin
  have A : tendsto (λ (x : R), a + x⁻¹) at_top (𝓝 (a + 0)) :=
    tendsto_const_nhds.add tendsto_inv_at_top_zero,
  rw add_zero at A,
  apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds A,
  { refine eventually_at_top.2 ⟨1, λ x hx, _⟩,
    rw le_div_iff (zero_lt_one.trans_le hx),
    exact nat.le_ceil _ },
  { refine eventually_at_top.2 ⟨1, λ x hx, _⟩,
    simp [div_le_iff (zero_lt_one.trans_le hx), inv_mul_cancel (zero_lt_one.trans_le hx).ne',
      (nat.ceil_lt_add_one ((mul_nonneg ha (zero_le_one.trans hx)))).le, add_mul] }
end

lemma tendsto_nat_ceil_div_at_top :
  tendsto (λ x, (⌈x⌉₊ : R) / x) at_top (𝓝 1) :=
by simpa using tendsto_nat_ceil_mul_div_at_top (zero_le_one' R)

end


/-
  Copyright (c) 2020 Anne Baanen. All rights reserved.
  Released under Apache 2.0 license as described in the file LICENSE.
  Author: Anne Baanen.

  The Special Linear group $SL(n, R)$
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.matrix
import Mathlib.linear_algebra.nonsingular_inverse
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# The Special Linear group $SL(n, R)$

This file defines the elements of the Special Linear group `special_linear_group n R`,
also written `SL(n, R)` or `SLₙ(R)`, consisting of all `n` by `n` `R`-matrices with
determinant `1`.  In addition, we define the group structure on `special_linear_group n R`
and the embedding into the general linear group `general_linear_group R (n → R)`
(i.e. `GL(n, R)` or `GLₙ(R)`).

## Main definitions

 * `matrix.special_linear_group` is the type of matrices with determinant 1
 * `matrix.special_linear_group.group` gives the group structure (under multiplication)
 * `matrix.special_linear_group.embedding_GL` is the embedding `SLₙ(R) → GLₙ(R)`

## Implementation notes
The inverse operation in the `special_linear_group` is defined to be the adjugate
matrix, so that `special_linear_group n R` has a group structure for all `comm_ring R`.

We define the elements of `special_linear_group` to be matrices, since we need to
compute their determinant. This is in contrast with `general_linear_group R M`,
which consists of invertible `R`-linear maps on `M`.

## References

 * https://en.wikipedia.org/wiki/Special_linear_group

## Tags

matrix group, group, matrix inverse
-/

namespace matrix

/-- `special_linear_group n R` is the group of `n` by `n` `R`-matrices with determinant equal to 1. -/
def special_linear_group (n : Type u) [DecidableEq n] [fintype n] (R : Type v) [comm_ring R] :=
  Subtype fun (A : matrix n n R) => det A = 1

namespace special_linear_group

protected instance coe_matrix {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : has_coe (special_linear_group n R) (matrix n n R) :=
  has_coe.mk fun (A : special_linear_group n R) => subtype.val A

protected instance coe_fun {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : has_coe_to_fun (special_linear_group n R) :=
  has_coe_to_fun.mk (fun (_x : special_linear_group n R) => n → n → R) fun (A : special_linear_group n R) => subtype.val A

/--
  `to_lin' A` is matrix multiplication of vectors by `A`, as a linear map.

  After the group structure on `special_linear_group n R` is defined,
  we show in `to_linear_equiv` that this gives a linear equivalence.
-/
def to_lin' {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : linear_map R (n → R) (n → R) :=
  coe_fn to_lin' ⇑A

theorem ext_iff {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) (B : special_linear_group n R) : A = B ↔ ∀ (i j : n), coe_fn A i j = coe_fn B i j :=
  iff.trans subtype.ext_iff_val
    { mp := fun (h : subtype.val A = subtype.val B) (i j : n) => congr_fun (congr_fun h i) j, mpr := ext }

theorem ext {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) (B : special_linear_group n R) : (∀ (i j : n), coe_fn A i j = coe_fn B i j) → A = B :=
  iff.mpr (ext_iff A B)

protected instance has_inv {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : has_inv (special_linear_group n R) :=
  has_inv.mk fun (A : special_linear_group n R) => { val := adjugate ⇑A, property := sorry }

protected instance has_mul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : Mul (special_linear_group n R) :=
  { mul :=
      fun (A B : special_linear_group n R) => { val := matrix.mul (subtype.val A) (subtype.val B), property := sorry } }

protected instance has_one {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : HasOne (special_linear_group n R) :=
  { one := { val := 1, property := sorry } }

protected instance inhabited {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : Inhabited (special_linear_group n R) :=
  { default := 1 }

@[simp] theorem inv_val {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : ↑(A⁻¹) = adjugate ⇑A :=
  rfl

@[simp] theorem inv_apply {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : ⇑(A⁻¹) = adjugate ⇑A :=
  rfl

@[simp] theorem mul_val {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) (B : special_linear_group n R) : ↑(A * B) = matrix.mul ⇑A ⇑B :=
  rfl

@[simp] theorem mul_apply {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) (B : special_linear_group n R) : ⇑(A * B) = matrix.mul ⇑A ⇑B :=
  rfl

@[simp] theorem one_val {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : ↑1 = 1 :=
  rfl

@[simp] theorem one_apply {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : ⇑1 = 1 :=
  rfl

@[simp] theorem det_coe_matrix {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : det ⇑A = 1 :=
  subtype.property A

theorem det_coe_fun {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : det ⇑A = 1 :=
  subtype.property A

@[simp] theorem to_lin'_mul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) (B : special_linear_group n R) : to_lin' (A * B) = linear_map.comp (to_lin' A) (to_lin' B) :=
  to_lin'_mul ⇑A ⇑B

@[simp] theorem to_lin'_one {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : to_lin' 1 = linear_map.id :=
  to_lin'_one

protected instance group {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : group (special_linear_group n R) :=
  group.mk Mul.mul sorry 1 sorry sorry has_inv.inv (div_inv_monoid.div._default Mul.mul sorry 1 sorry sorry has_inv.inv)
    sorry

/-- `to_linear_equiv A` is matrix multiplication of vectors by `A`, as a linear equivalence. -/
def to_linear_equiv {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : linear_equiv R (n → R) (n → R) :=
  linear_equiv.mk (linear_map.to_fun (coe_fn to_lin' ⇑A)) sorry sorry ⇑(to_lin' (A⁻¹)) sorry sorry

/-- `to_GL` is the map from the special linear group to the general linear group -/
def to_GL {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : linear_map.general_linear_group R (n → R) :=
  linear_map.general_linear_group.of_linear_equiv (to_linear_equiv A)

theorem coe_to_GL {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) : ↑(to_GL A) = to_lin' A :=
  rfl

@[simp] theorem to_GL_one {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : to_GL 1 = 1 := sorry

@[simp] theorem to_GL_mul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (A : special_linear_group n R) (B : special_linear_group n R) : to_GL (A * B) = to_GL A * to_GL B := sorry

/-- `special_linear_group.embedding_GL` is the embedding from `special_linear_group n R`
  to `general_linear_group n R`. -/
def embedding_GL {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : special_linear_group n R →* linear_map.general_linear_group R (n → R) :=
  monoid_hom.mk (fun (A : special_linear_group n R) => to_GL A) sorry sorry


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.fin2
import data.pfun
import data.vector3
import number_theory.pell

/-!
# Diophantine functions and Matiyasevic's theorem

Hilbert's tenth problem asked whether there exists an algorithm which for a given integer polynomial
determines whether this polynomial has integer solutions. It was answered in the negative in 1970,
the final step being completed by Matiyasevic who showed that the power function is Diophantine.

Here a function is called Diophantine if its graph is Diophantine as a set. A subset `S ⊆ ℕ ^ α` in
turn is called Diophantine if there exists an integer polynomial on `α ⊕ β` such that `v ∈ S` iff
there exists `t : ℕ^β` with `p (v, t) = 0`.

## Main definitions

* `is_poly`: a predicate stating that a function is a multivariate integer polynomial.
* `poly`: the type of multivariate integer polynomial functions.
* `dioph`: a predicate stating that a set is Diophantine, i.e. a set `S ⊆ ℕ^α` is
  Diophantine if there exists a polynomial on `α ⊕ β` such that `v ∈ S` iff there
  exists `t : ℕ^β` with `p (v, t) = 0`.
* `dioph_fn`: a predicate on a function stating that it is Diophantine in the sense that its graph
  is Diophantine as a set.

## Main statements

* `pell_dioph` states that solutions to Pell's equation form a Diophantine set.
* `pow_dioph` states that the power function is Diophantine, a version of Matiyasevic's theorem.

## References

* [M. Carneiro, _A Lean formalization of Matiyasevic's theorem_][carneiro2018matiyasevic]
* [M. Davis, _Hilbert's tenth problem is unsolvable_][MR317916]

## Tags

Matiyasevic's theorem, Hilbert's tenth problem

## TODO

* Finish the solution of Hilbert's tenth problem.
* Connect `poly` to `mv_polynomial`
-/

open fin2 function nat sum

local infixr ` ::ₒ `:67 := option.elim
local infixr ` ⊗ `:65 := sum.elim

universe u

/-!
### Multivariate integer polynomials

Note that this duplicates `mv_polynomial`.
-/

section polynomials
variables {α β γ : Type*}

/-- A predicate asserting that a function is a multivariate integer polynomial.
  (We are being a bit lazy here by allowing many representations for multiplication,
  rather than only allowing monomials and addition, but the definition is equivalent
  and this is easier to use.) -/
inductive is_poly : ((α → ℕ) → ℤ) → Prop
| proj : ∀ i, is_poly (λ x : α → ℕ, x i)
| const : Π (n : ℤ), is_poly (λ x : α → ℕ, n)
| sub : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λ x, f x - g x)
| mul : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λ x, f x * g x)

lemma is_poly.neg {f : (α → ℕ) → ℤ} : is_poly f → is_poly (-f) :=
by { rw ←zero_sub, exact (is_poly.const 0).sub }

lemma is_poly.add {f g : (α → ℕ) → ℤ} (hf : is_poly f) (hg : is_poly g) : is_poly (f + g) :=
by { rw ←sub_neg_eq_add, exact hf.sub hg.neg }

/-- The type of multivariate integer polynomials -/
def poly (α : Type u) := {f : (α → ℕ) → ℤ // is_poly f}

namespace poly
section

instance fun_like : fun_like (poly α) (α → ℕ) (λ _, ℤ) := ⟨subtype.val, subtype.val_injective⟩

/-- Helper instance for when there are too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (poly α) (λ _, (α → ℕ) → ℤ) := fun_like.has_coe_to_fun

/-- The underlying function of a `poly` is a polynomial -/
protected lemma is_poly (f : poly α) : is_poly f := f.2

/-- Extensionality for `poly α` -/
@[ext] lemma ext {f g : poly α} : (∀ x, f x = g x) →  f = g := fun_like.ext _ _

/-- The `i`th projection function, `x_i`. -/
def proj (i) : poly α := ⟨_, is_poly.proj i⟩
@[simp] lemma proj_apply (i : α) (x) : proj i x = x i := rfl

/-- The constant function with value `n : ℤ`. -/
def const (n) : poly α := ⟨_, is_poly.const n⟩
@[simp] lemma const_apply (n) (x : α → ℕ) : const n x = n := rfl

instance : has_zero (poly α) := ⟨const 0⟩
instance : has_one (poly α) := ⟨const 1⟩
instance : has_neg (poly α) := ⟨λ f, ⟨-f, f.2.neg⟩⟩
instance : has_add (poly α) := ⟨λ f g, ⟨f + g, f.2.add g.2⟩⟩
instance : has_sub (poly α) := ⟨λ f g, ⟨f - g, f.2.sub g.2⟩⟩
instance : has_mul (poly α) := ⟨λ f g, ⟨f * g, f.2.mul g.2⟩⟩

@[simp] lemma coe_zero : ⇑(0 : poly α) = const 0 := rfl
@[simp]

@[simp] lemma zero_apply (x) : (0 : poly α) x = 0 := rfl
@[simp] lemma one_apply (x) : (1 : poly α) x = 1 := rfl
@[simp] lemma neg_apply (f : poly α) (x) : (-f) x = -f x := rfl
@[simp] lemma add_apply (f g : poly α) (x : α → ℕ) : (f + g) x = f x + g x := rfl
@[simp] lemma sub_apply (f g : poly α) (x : α → ℕ) : (f - g) x = f x - g x := rfl
@[simp] lemma mul_apply (f g : poly α) (x : α → ℕ) : (f * g) x = f x * g x := rfl

instance (α : Type*) : inhabited (poly α) := ⟨0⟩

instance : add_comm_group (poly α) := by refine_struct
{ add   := ((+) : poly α → poly α → poly α),
  neg   := (has_neg.neg : poly α → poly α),
  sub   := (has_sub.sub),
  zero  := 0,
  zsmul := @zsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ ⟨has_neg.neg⟩,
  nsmul := @nsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ };
intros; try { refl }; refine ext (λ _, _);
simp [sub_eq_add_neg, add_comm, add_assoc]

instance : add_group_with_one (poly α) :=
{ one := 1,
  nat_cast := λ n, poly.const n,
  int_cast := poly.const,
  .. poly.add_comm_group }

instance : comm_ring (poly α) := by refine_struct
{ add   := ((+) : poly α → poly α → poly α),
  zero  := 0,
  mul   := (*),
  one   := 1,
  npow  := @npow_rec _ ⟨(1 : poly α)⟩ ⟨(*)⟩,
  .. poly.add_group_with_one, .. poly.add_comm_group };
intros; try { refl }; refine ext (λ _, _);
simp [sub_eq_add_neg, mul_add, mul_left_comm, mul_comm, add_comm, add_assoc]

lemma induction {C : poly α → Prop}
  (H1 : ∀i, C (proj i)) (H2 : ∀n, C (const n))
  (H3 : ∀f g, C f → C g → C (f - g))
  (H4 : ∀f g, C f → C g → C (f * g)) (f : poly α) : C f :=
begin
  cases f with f pf,
  induction pf with i n f g pf pg ihf ihg f g pf pg ihf ihg,
  apply H1, apply H2, apply H3 _ _ ihf ihg, apply H4 _ _ ihf ihg
end

/-- The sum of squares of a list of polynomials. This is relevant for
  Diophantine equations, because it means that a list of equations
  can be encoded as a single equation: `x = 0 ∧ y = 0 ∧ z = 0` is
  equivalent to `x^2 + y^2 + z^2 = 0`. -/
def sumsq : list (poly α) → poly α
| []      := 0
| (p::ps) := p*p + sumsq ps

lemma sumsq_nonneg (x : α → ℕ) : ∀ l, 0 ≤ sumsq l x
| []      := le_refl 0
| (p::ps) := by rw sumsq; simp [-add_comm];
                exact add_nonneg (mul_self_nonneg _) (sumsq_nonneg ps)

lemma sumsq_eq_zero (x) : ∀ l, sumsq l x = 0 ↔ l.all₂ (λ a : poly α, a x = 0)
| []      := eq_self_iff_true _
| (p::ps) := by rw [list.all₂_cons, ← sumsq_eq_zero ps]; rw sumsq; simp [-add_comm]; exact
  ⟨λ (h : p x * p x + sumsq ps x = 0),
   have p x = 0, from eq_zero_of_mul_self_eq_zero $ le_antisymm
     (by rw ← h; have t := add_le_add_left (sumsq_nonneg x ps) (p x * p x); rwa [add_zero] at t)
     (mul_self_nonneg _),
   ⟨this, by simp [this] at h; exact h⟩,
  λ ⟨h1, h2⟩, by rw [h1, h2]; refl⟩

end

/-- Map the index set of variables, replacing `x_i` with `x_(f i)`. -/
def map {α β} (f : α → β) (g : poly α) : poly β :=
⟨λ v, g $ v ∘ f, g.induction
  (λ i, by simp; apply is_poly.proj)
  (λ n, by simp; apply is_poly.const)
  (λ f g pf pg, by simp; apply is_poly.sub pf pg)
  (λ f g pf pg, by simp; apply is_poly.mul pf pg)⟩
@[simp] lemma map_apply {α β} (f : α → β) (g : poly α) (v) : map f g v = g (v ∘ f) := rfl

end poly
end polynomials

/-! ### Diophantine sets -/

/-- A set `S ⊆ ℕ^α` is Diophantine if there exists a polynomial on
  `α ⊕ β` such that `v ∈ S` iff there exists `t : ℕ^β` with `p (v, t) = 0`. -/
def dioph {α : Type u} (S : set (α → ℕ)) : Prop :=
∃ {β : Type u} (p : poly (α ⊕ β)), ∀ v, S v ↔ ∃ t, p (v ⊗ t) = 0

namespace dioph
section
variables {α β γ : Type u} {S S' : set (α → ℕ)}

lemma ext (d : dioph S) (H : ∀ v, v ∈  S ↔ v ∈ S') : dioph S' := by rwa ←set.ext H

lemma of_no_dummies (S : set (α → ℕ)) (p : poly α) (h : ∀ v, S v ↔ p v = 0) : dioph S :=
⟨pempty, p.map inl, λ v, (h v).trans ⟨λ h, ⟨pempty.rec _, h⟩, λ ⟨t, ht⟩, ht⟩⟩

lemma inject_dummies_lem (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x)
  (p : poly (α ⊕ β)) (v : α → ℕ) :
  (∃ t, p (v ⊗ t) = 0) ↔ ∃ t, p.map (inl ⊗ inr ∘ f) (v ⊗ t) = 0 :=
begin
  dsimp, refine ⟨λ t, _, λ t, _⟩; cases t with t ht,
  { have : (v ⊗ (0 ::ₒ t) ∘ g) ∘ (inl ⊗ inr ∘ f) = v ⊗ t :=
    funext (λ s, by cases s with a b; dsimp [(∘)]; try {rw inv}; refl),
    exact ⟨(0 ::ₒ t) ∘ g, by rwa this⟩ },
  { have : v ⊗ t ∘ f = (v ⊗ t) ∘ (inl ⊗ inr ∘ f) :=
    funext (λ s, by cases s with a b; refl),
    exact ⟨t ∘ f, by rwa this⟩ }
end

lemma inject_dummies (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x) (p : poly (α ⊕ β))
  (h : ∀ v, S v ↔ ∃ t, p (v ⊗ t) = 0) :
  ∃ q : poly (α ⊕ γ), ∀ v, S v ↔ ∃ t, q (v ⊗ t) = 0 :=
⟨p.map (inl ⊗ (inr ∘ f)), λ v, (h v).trans $ inject_dummies_lem f g inv _ _⟩

variables (β)

lemma reindex_dioph (f : α → β) : Π (d : dioph S), dioph {v | v ∘ f ∈ S}
| ⟨γ, p, pe⟩ := ⟨γ, p.map ((inl ∘ f) ⊗ inr), λ v, (pe _).trans $ exists_congr $ λ t,
  suffices v ∘ f ⊗ t = (v ⊗ t) ∘ (inl ∘ f ⊗ inr), by simp [this],
  funext $ λ s, by cases s with a b; refl⟩

variables {β}

lemma dioph_list.all₂ (l : list (set $ α → ℕ)) (d : l.all₂ dioph) :
  dioph {v | l.all₂ (λ S : set (α → ℕ), v ∈ S)} :=
suffices ∃ β (pl : list (poly (α ⊕ β))), ∀ v,
  list.all₂ (λ S : set _, S v) l ↔ ∃ t, list.all₂ (λ p : poly (α ⊕ β), p (v ⊗ t) = 0) pl,
from let ⟨β, pl, h⟩ := this
  in ⟨β, poly.sumsq pl, λ v, (h v).trans $ exists_congr $ λ t, (poly.sumsq_eq_zero _ _).symm⟩,
begin
  induction l with S l IH,
  exact ⟨ulift empty, [], λ v, by simp; exact ⟨λ ⟨t⟩, empty.rec _ t, trivial⟩⟩,
  simp at d,
  exact let ⟨⟨β, p, pe⟩, dl⟩ := d, ⟨γ, pl, ple⟩ := IH dl in
  ⟨β ⊕ γ, p.map (inl ⊗ inr ∘ inl) :: pl.map (λ q, q.map (inl ⊗ (inr ∘ inr))), λ v,
    by simp; exact iff.trans (and_congr (pe v) (ple v))
    ⟨λ ⟨⟨m, hm⟩, ⟨n, hn⟩⟩,
      ⟨m ⊗ n, by rw [
        show (v ⊗ m ⊗ n) ∘ (inl ⊗ inr ∘ inl) = v ⊗ m,
        from funext $ λ s, by cases s with a b; refl]; exact hm,
      by { refine list.all₂.imp (λ q hq, _) hn, dsimp [(∘)],
           rw [show (λ (x : α ⊕ γ), (v ⊗ m ⊗ n) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ n,
               from funext $ λ s, by cases s with a b; refl]; exact hq }⟩,
    λ ⟨t, hl, hr⟩,
      ⟨⟨t ∘ inl, by rwa [
        show (v ⊗ t) ∘ (inl ⊗ inr ∘ inl) = v ⊗ t ∘ inl,
        from funext $ λ s, by cases s with a b; refl] at hl⟩,
      ⟨t ∘ inr, by
      { refine list.all₂.imp (λ q hq, _) hr, dsimp [(∘)] at hq,
        rwa [show (λ (x : α ⊕ γ), (v ⊗ t) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ t ∘ inr,
             from funext $ λ s, by cases s with a b; refl] at hq }⟩⟩⟩⟩
end

lemma inter (d : dioph S) (d' : dioph S') : dioph (S ∩ S') := dioph_list.all₂ [S, S'] ⟨d, d'⟩

lemma union : ∀ (d : dioph S) (d' : dioph S'), dioph (S ∪ S')
| ⟨β, p, pe⟩ ⟨γ, q, qe⟩ := ⟨β ⊕ γ, p.map (inl ⊗ inr ∘ inl) * q.map (inl ⊗ inr ∘ inr), λ v,
  begin
    refine iff.trans (or_congr ((pe v).trans _) ((qe v).trans _))
      (exists_or_distrib.symm.trans (exists_congr $ λ t,
      (@mul_eq_zero _ _ _ (p ((v ⊗ t) ∘ (inl ⊗ inr ∘ inl)))
        (q ((v ⊗ t) ∘ (inl ⊗ inr ∘ inr)))).symm)),
    exact inject_dummies_lem _ (some ⊗ (λ _, none)) (λ x, rfl) _ _,
    exact inject_dummies_lem _ ((λ _, none) ⊗ some) (λ x, rfl) _ _,
  end⟩

/-- A partial function is Diophantine if its graph is Diophantine. -/
def dioph_pfun (f : (α → ℕ) →. ℕ) : Prop := dioph {v : option α → ℕ | f.graph (v ∘ some, v none)}

/-- A function is Diophantine if its graph is Diophantine. -/
def dioph_fn (f : (α → ℕ) → ℕ) : Prop := dioph {v : option α → ℕ | f (v ∘ some) = v none}

lemma reindex_dioph_fn {f : (α → ℕ) → ℕ} (g : α → β) (d : dioph_fn f) : dioph_fn (λ v, f (v ∘ g)) :=
by convert reindex_dioph (option β) (option.map g) d

lemma ex_dioph {S : set (α ⊕ β → ℕ)} : dioph S → dioph {v | ∃ x, v ⊗ x ∈ S}
| ⟨γ, p, pe⟩ := ⟨β ⊕ γ, p.map ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr), λ v,
  ⟨λ ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x ⊗ t, by simp; rw [
    show (v ⊗ x ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ x) ⊗ t,
    from funext $ λ s, by cases s with a b; try {cases a}; refl]; exact ht⟩,
  λ ⟨t, ht⟩, ⟨t ∘ inl, (pe _).2 ⟨t ∘ inr, by simp at ht; rwa [
    show (v ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ t ∘ inl) ⊗ t ∘ inr,
    from funext $ λ s, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

lemma ex1_dioph {S : set (option α → ℕ)} : dioph S → dioph {v | ∃ x, x ::ₒ v ∈ S}
| ⟨β, p, pe⟩ := ⟨option β, p.map (inr none ::ₒ inl ⊗ inr ∘ some), λ v,
  ⟨λ ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x ::ₒ t, by simp; rw [
    show (v ⊗ x ::ₒ t) ∘ (inr none ::ₒ inl ⊗ inr ∘ some) = x ::ₒ v ⊗ t,
    from funext $ λ s, by cases s with a b; try {cases a}; refl]; exact ht⟩,
  λ ⟨t, ht⟩, ⟨t none, (pe _).2 ⟨t ∘ some, by simp at ht; rwa [
    show (v ⊗ t) ∘ (inr none ::ₒ inl ⊗ inr ∘ some) = t none ::ₒ v ⊗ t ∘ some,
    from funext $ λ s, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

theorem dom_dioph {f : (α → ℕ) →. ℕ} (d : dioph_pfun f) : dioph f.dom :=
cast (congr_arg dioph $ set.ext $ λ v, (pfun.dom_iff_graph _ _).symm) (ex1_dioph d)

theorem dioph_fn_iff_pfun (f : (α → ℕ) → ℕ) : dioph_fn f = @dioph_pfun α f :=
by refine congr_arg dioph (set.ext $ λ v, _); exact pfun.lift_graph.symm

lemma abs_poly_dioph (p : poly α) : dioph_fn (λ v, (p v).nat_abs) :=
of_no_dummies _ ((p.map some - poly.proj none) * (p.map some + poly.proj none)) $ λ v,
 by { dsimp, exact int.eq_nat_abs_iff_mul_eq_zero }

theorem proj_dioph (i : α) : dioph_fn (λ v, v i) :=
abs_poly_dioph (poly.proj i)

theorem dioph_pfun_comp1 {S : set (option α → ℕ)} (d : dioph S) {f} (df : dioph_pfun f) :
  dioph {v :  α → ℕ | ∃ h : f.dom v, f.fn v h ::ₒ v ∈ S} :=
ext (ex1_dioph (d.inter df)) $ λ v,
⟨λ ⟨x, hS, (h: Exists _)⟩, by
  rw [show (x ::ₒ v) ∘ some = v, from funext $ λ s, rfl] at h;
  cases h with hf h; refine ⟨hf, _⟩; rw [pfun.fn, h]; exact hS,
λ ⟨x, hS⟩, ⟨f.fn v x, hS, show Exists _,
  by rw [show (f.fn v x ::ₒ v) ∘ some = v, from funext $ λ s, rfl]; exact ⟨x, rfl⟩⟩⟩

theorem dioph_fn_comp1 {S : set (option α → ℕ)} (d : dioph S) {f : (α → ℕ) → ℕ} (df : dioph_fn f) :
  dioph {v | f v ::ₒ v ∈ S} :=
ext (dioph_pfun_comp1 d $ cast (dioph_fn_iff_pfun f) df) $ λ v,
⟨λ ⟨_, h⟩, h, λ h, ⟨trivial, h⟩⟩

end

section
variables {α β : Type} {n : ℕ}

open vector3
open_locale vector3

local attribute [reducible] vector3

lemma dioph_fn_vec_comp1 {S : set (vector3 ℕ (succ n))} (d : dioph S) {f : vector3 ℕ n → ℕ}
  (df : dioph_fn f) :
  dioph {v : vector3 ℕ n | f v :: v ∈ S} :=
ext (dioph_fn_comp1 (reindex_dioph _ (none :: some) d) df) $ λ v,
  by { dsimp, congr', ext x, cases x; refl }

theorem vec_ex1_dioph (n) {S : set (vector3 ℕ (succ n))} (d : dioph S) :
  dioph {v : fin2 n → ℕ | ∃ x, x :: v ∈ S} :=
ext (ex1_dioph $ reindex_dioph _ (none :: some) d) $ λ v, exists_congr $ λ x, by { dsimp,
  rw [show option.elim x v ∘ cons none some = x :: v,
  from funext $ λ s, by cases s with a b; refl] }

lemma dioph_fn_vec (f : vector3 ℕ n → ℕ) : dioph_fn f ↔ dioph {v | f (v ∘ fs) = v fz} :=
⟨reindex_dioph _ (fz ::ₒ fs), reindex_dioph _ (none :: some)⟩

lemma dioph_pfun_vec (f : vector3 ℕ n →. ℕ) : dioph_pfun f ↔ dioph {v | f.graph (v ∘ fs, v fz)} :=
⟨reindex_dioph _ (fz ::ₒ fs), reindex_dioph _ (none :: some)⟩

lemma dioph_fn_compn : ∀ {n} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S)
  {f : vector3 ((α → ℕ) → ℕ) n} (df : vector_allp dioph_fn f),
  dioph {v : α → ℕ | v ⊗ (λ i, f i v) ∈ S}
| 0 S d f := λ df, ext (reindex_dioph _ (id ⊗ fin2.elim0) d) $ λ v,
  by { dsimp, congr', ext x, obtain (_ | _ | _) := x, refl }
| (succ n) S d f := f.cons_elim $ λ f fl, by simp; exact λ df dfl,
  have dioph {v |v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr ∈ S},
  from ext (dioph_fn_comp1 (reindex_dioph _ (some ∘ inl ⊗ none :: some ∘ inr) d) $
    reindex_dioph_fn inl df) $ λ v,
  by { dsimp, congr', ext x, obtain (_ | _ | _) := x; refl },
  have dioph {v | v ⊗ f v :: (λ (i : fin2 n), fl i v) ∈ S},
  from @dioph_fn_compn n (λ v, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)) this _ dfl,
  ext this $ λ v, by { dsimp, congr', ext x, obtain (_ | _ | _) := x; refl }

lemma dioph_comp {S : set (vector3 ℕ n)} (d : dioph S) (f : vector3 ((α → ℕ) → ℕ) n)
  (df : vector_allp dioph_fn f) : dioph {v | (λ i, f i v) ∈ S} :=
dioph_fn_compn (reindex_dioph _ inr d) df

lemma dioph_fn_comp {f : vector3 ℕ n → ℕ} (df : dioph_fn f) (g : vector3 ((α → ℕ) → ℕ) n)
  (dg : vector_allp dioph_fn g) : dioph_fn (λ v, f (λ i, g i v)) :=
dioph_comp ((dioph_fn_vec _).1 df) ((λ v, v none) :: λ i v, g i (v ∘ some)) $
by simp; exact ⟨proj_dioph none, (vector_allp_iff_forall _ _).2 $ λ i,
  reindex_dioph_fn _ $ (vector_allp_iff_forall _ _).1 dg _⟩

localized "notation x ` D∧ `:35 y := dioph.inter x y" in dioph
localized "notation x ` D∨ `:35 y := dioph.union x y" in dioph

localized "notation `D∃`:30 := dioph.vec_ex1_dioph" in dioph

localized "prefix `&`:max := fin2.of_nat'" in dioph
theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [is_lt m n] : dioph_fn (λ v : vector3 ℕ n, v &m) :=
proj_dioph &m
localized "prefix `D&`:100 := dioph.proj_dioph_of_nat" in dioph

theorem const_dioph (n : ℕ) : dioph_fn (const (α → ℕ) n) :=
abs_poly_dioph (poly.const n)
localized "prefix `D.`:100 := dioph.const_dioph" in dioph

variables {f g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g)
include df dg

lemma dioph_comp2 {S : ℕ → ℕ → Prop} (d : dioph (λ v:vector3 ℕ 2, S (v &0) (v &1))) :
  dioph (λ v, S (f v) (g v)) :=
dioph_comp d [f, g] (by exact ⟨df, dg⟩)

lemma dioph_fn_comp2 {h : ℕ → ℕ → ℕ} (d : dioph_fn (λ v:vector3 ℕ 2, h (v &0) (v &1))) :
  dioph_fn (λ v, h (f v) (g v)) :=
dioph_fn_comp d [f, g] (by exact ⟨df, dg⟩)

lemma eq_dioph : dioph (λ v, f v = g v) :=
dioph_comp2 df dg $ of_no_dummies _ (poly.proj &0 - poly.proj &1)
  (λ v, (int.coe_nat_eq_coe_nat_iff _ _).symm.trans
  ⟨@sub_eq_zero_of_eq ℤ _ (v &0) (v &1), eq_of_sub_eq_zero⟩)
localized "infix ` D= `:50 := dioph.eq_dioph" in dioph

lemma add_dioph : dioph_fn (λ v, f v + g v) :=
dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 + poly.proj &1)
localized "infix ` D+ `:80 := dioph.add_dioph" in dioph

lemma mul_dioph : dioph_fn (λ v, f v * g v) :=
dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 * poly.proj &1)
localized "infix ` D* `:90 := dioph.mul_dioph" in dioph

lemma le_dioph : dioph {v | f v ≤ g v} :=
dioph_comp2 df dg $ ext (D∃2 $ D&1 D+ D&0 D= D&2) (λ v, ⟨λ ⟨x, hx⟩, le.intro hx, le.dest⟩)
localized "infix ` D≤ `:50 := dioph.le_dioph" in dioph

lemma lt_dioph : dioph {v | f v < g v} := df D+ (D. 1) D≤ dg
localized "infix ` D< `:50 := dioph.lt_dioph" in dioph

lemma ne_dioph : dioph {v | f v ≠ g v} :=
ext (df D< dg D∨ dg D< df) $ λ v, by { dsimp, exact lt_or_lt_iff_ne }
localized "infix ` D≠ `:50 := dioph.ne_dioph" in dioph

lemma sub_dioph : dioph_fn (λ v, f v - g v) :=
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $
ext (D&1 D= D&0 D+ D&2 D∨ D&1 D≤ D&2 D∧ D&0 D= D.0) $ (vector_all_iff_forall _).1 $ λ x y z,
show (y = x + z ∨ y ≤ z ∧ x = 0) ↔ y - z = x, from
⟨λ o, begin
  rcases o with ae | ⟨yz, x0⟩,
  { rw [ae, add_tsub_cancel_right] },
  { rw [x0, tsub_eq_zero_iff_le.mpr yz] }
end, begin
  rintro rfl,
  cases le_total y z with yz zy,
  { exact or.inr ⟨yz, tsub_eq_zero_iff_le.mpr yz⟩ },
  { exact or.inl (tsub_add_cancel_of_le zy).symm },
end⟩
localized "infix ` D- `:80 := dioph.sub_dioph" in dioph

lemma dvd_dioph : dioph (λ v, f v ∣ g v) :=
dioph_comp (D∃2 $ D&2 D= D&1 D* D&0) [f, g] (by exact ⟨df, dg⟩)
localized "infix ` D∣ `:50 := dioph.dvd_dioph" in dioph

lemma mod_dioph : dioph_fn (λ v, f v % g v) :=
have dioph (λ v : vector3 ℕ 3, (v &2 = 0 ∨ v &0 < v &2) ∧ ∃ (x : ℕ), v &0 + v &2 * x = v &1),
from (D&2 D= D.0 D∨ D&0 D< D&2) D∧ (D∃3 $ D&1 D+ D&3 D* D&0 D= D&2),
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λ z x y,
show ((y = 0 ∨ z < y) ∧ ∃ c, z + y * c = x) ↔ x % y = z, from
⟨λ ⟨h, c, hc⟩, begin rw ← hc; simp; cases h with x0 hl, rw [x0, mod_zero],
  exact mod_eq_of_lt hl end,
λ e, by rw ← e; exact ⟨or_iff_not_imp_left.2 $ λ h, mod_lt _ (nat.pos_of_ne_zero h), x / y,
  mod_add_div _ _⟩⟩

localized "infix ` D% `:80 := dioph.mod_dioph" in dioph

lemma modeq_dioph {h : (α → ℕ) → ℕ} (dh : dioph_fn h) : dioph (λ v, f v ≡ g v [MOD h v]) :=
df D% dh D= dg D% dh
localized "notation `D≡` := dioph.modeq_dioph" in dioph

lemma div_dioph : dioph_fn (λ v, f v / g v) :=
have dioph (λ v : vector3 ℕ 3, v &2 = 0 ∧ v &0 = 0 ∨ v &0 * v &2 ≤ v &1 ∧ v &1 < (v &0 + 1) * v &2),
from (D&2 D= D.0 D∧ D&0 D= D.0) D∨ D&0 D* D&2 D≤ D&1 D∧ D&1 D< (D&0 D+ D.1) D* D&2,
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λ z x y,
show y = 0 ∧ z = 0 ∨ z * y ≤ x ∧ x < (z + 1) * y ↔ x / y = z,
by refine iff.trans _ eq_comm; exact y.eq_zero_or_pos.elim
  (λ y0, by rw [y0, nat.div_zero]; exact
    ⟨λ o, (o.resolve_right $ λ ⟨_, h2⟩, nat.not_lt_zero _ h2).right, λ z0, or.inl ⟨rfl, z0⟩⟩)
  (λ ypos, iff.trans ⟨λ o, o.resolve_left $ λ ⟨h1, _⟩, ne_of_gt ypos h1, or.inr⟩
    (le_antisymm_iff.trans $ and_congr (nat.le_div_iff_mul_le ypos) $
      iff.trans ⟨lt_succ_of_le, le_of_lt_succ⟩ (div_lt_iff_lt_mul ypos)).symm)
localized "infix ` D/ `:80 := dioph.div_dioph" in dioph

omit df dg
open pell

lemma pell_dioph : dioph (λ v:vector3 ℕ 4, ∃ h : 1 < v &0,
  xn h (v &1) = v &2 ∧ yn h (v &1) = v &3) :=
have dioph {v : vector3 ℕ 4 |
1 < v &0 ∧ v &1 ≤ v &3 ∧
(v &2 = 1 ∧ v &3 = 0 ∨
∃ (u w s t b : ℕ),
  v &2 * v &2 - (v &0 * v &0 - 1) * v &3 * v &3 = 1 ∧
  u * u - (v &0 * v &0 - 1) * w * w = 1 ∧
  s * s - (b * b - 1) * t * t = 1 ∧
  1 < b ∧ (b ≡ 1 [MOD 4 * v &3]) ∧ (b ≡ v &0 [MOD u]) ∧
  0 < w ∧ v &3 * v &3 ∣ w ∧
  (s ≡ v &2 [MOD u]) ∧
  (t ≡ v &1 [MOD 4 * v &3]))}, from
D.1 D< D&0 D∧ D&1 D≤ D&3 D∧
((D&2 D= D.1 D∧ D&3 D= D.0) D∨
 (D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $
  D&7 D* D&7 D- (D&5 D* D&5 D- D.1) D* D&8 D* D&8 D= D.1 D∧
  D&4 D* D&4 D- (D&5 D* D&5 D- D.1) D* D&3 D* D&3 D= D.1 D∧
  D&2 D* D&2 D- (D&0 D* D&0 D- D.1) D* D&1 D* D&1 D= D.1 D∧
  D.1 D< D&0 D∧ (D≡ (D&0) (D.1) (D.4 D* D&8)) D∧ (D≡ (D&0) (D&5) D&4) D∧
  D.0 D< D&3 D∧ D&8 D* D&8 D∣ D&3 D∧
  (D≡ (D&2) (D&7) D&4) D∧
  (D≡ (D&1) (D&6) (D.4 D* D&8)))),
dioph.ext this $ λ v, matiyasevic.symm

lemma xn_dioph : dioph_pfun (λ v:vector3 ℕ 2, ⟨1 < v &0, λ h, xn h (v &1)⟩) :=
have dioph (λ v:vector3 ℕ 3, ∃ y, ∃ h : 1 < v &1, xn h (v &2) = v &0 ∧ yn h (v &2) = y), from
let D_pell := pell_dioph.reindex_dioph (fin2 4) [&2, &3, &1, &0] in D∃3 D_pell,
(dioph_pfun_vec _).2 $ dioph.ext this $ λ v, ⟨λ ⟨y, h, xe, ye⟩, ⟨h, xe⟩, λ ⟨h, xe⟩, ⟨_, h, xe, rfl⟩⟩

include df dg
/-- A version of **Matiyasevic's theorem** -/
theorem pow_dioph : dioph_fn (λ v, f v ^ g v) :=
have dioph {v : vector3 ℕ 3 |
v &2 = 0 ∧ v &0 = 1 ∨ 0 < v &2 ∧
(v &1 = 0 ∧ v &0 = 0 ∨ 0 < v &1 ∧
∃ (w a t z x y : ℕ),
  (∃ (a1 : 1 < a), xn a1 (v &2) = x ∧ yn a1 (v &2) = y) ∧
  (x ≡ y * (a - v &1) + v &0 [MOD t]) ∧
  2 * a * v &1 = t + (v &1 * v &1 + 1) ∧
  v &0 < t ∧ v &1 ≤ w ∧ v &2 ≤ w ∧
  a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)}, from
let D_pell := pell_dioph.reindex_dioph (fin2 9) [&4, &8, &1, &0] in
(D&2 D= D.0 D∧ D&0 D= D.1) D∨ (D.0 D< D&2 D∧
((D&1 D= D.0 D∧ D&0 D= D.0) D∨ (D.0 D< D&1 D∧
 (D∃3 $ D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $ D_pell D∧
  (D≡ (D&1) (D&0 D* (D&4 D- D&7) D+ D&6) (D&3)) D∧
  D.2 D* D&4 D* D&7 D= D&3 D+ (D&7 D* D&7 D+ D.1) D∧
  D&6 D< D&3 D∧ D&7 D≤ D&5 D∧ D&8 D≤ D&5 D∧
  D&4 D* D&4 D- ((D&5 D+ D.1) D* (D&5 D+ D.1) D- D.1) D* (D&5 D* D&2) D* (D&5 D* D&2) D= D.1)))),
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ dioph.ext this $ λ v, iff.symm $
eq_pow_of_pell.trans $ or_congr iff.rfl $ and_congr iff.rfl $ or_congr iff.rfl $ and_congr iff.rfl $
⟨λ ⟨w, a, t, z, a1, h⟩, ⟨w, a, t, z, _, _, ⟨a1, rfl, rfl⟩, h⟩,
 λ ⟨w, a, t, z, ._, ._, ⟨a1, rfl, rfl⟩, h⟩, ⟨w, a, t, z, a1, h⟩⟩

end
end dioph


import data.set.basic

variables (R A : Type)
variables (𝕍 : set R → set A) (𝕀 : set A → set R)

open set

-- 𝕍 𝕀 𝕍 = 𝕍 for a contravariant Galois connection
-- for example the one between R=k[X₁,X₂,…,Xₙ] and A=𝔸ⁿ
-- in the theory of algebraic varieties

-- NB type `\bbV` to get the blackboard bold V, and `\bbI` for the I
example
  (𝕍_antimono : ∀ J₁ J₂ : set R, J₁ ⊆ J₂ → 𝕍 J₂ ⊆ 𝕍 J₁)
  (𝕀_antimono : ∀ W₁ W₂ : set A, W₁ ⊆ W₂ → 𝕀 W₂ ⊆ 𝕀 W₁)
  (galois : ∀ J : set R, ∀ W : set A, J ⊆ 𝕀 W ↔ W ⊆ 𝕍 J) :
  ∀ J : set R, 𝕍 (𝕀 (𝕍 J)) = 𝕍 J :=
begin
  sorry
end


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic
import measure_theory.function.lp_space -- theory of ℓᵖ spaces

/-

# Lᵖ spaces

The set-up : `X` is a type equipped with a (sigma algebra and a) measure.

The space ℒp X
-/

open measure_theory

variables (X : Type) [measurable_space X] (μ : measure X)

-- Instead of functions from X to ℝ, Lean is happy to work with functions from X to
-- some arbitrary `normed_add_comm_group`

variables (F : Type) [normed_add_comm_group F]

-- Functions from X to F have an Lᵖ seminorm defined on them, if `p : ℝ≥0∞`

open_locale ennreal

variables (f : X → F) (p : ℝ≥0∞)

-- the integral (∫ ‖f a‖^p ∂μ) ^ (1/p)
noncomputable example : ℝ≥0∞ := snorm f p μ

-- `mem_ℒp` is the predicate saying that this integral is finite
example : Prop := mem_ℒp f p μ

-- The reason it's called `snorm` not `norm`, is because we didn't yet quotient out by
-- the things whose integral is zero. This quotient is called `Lp`

example : Type := Lp F p μ

example : add_comm_group (Lp F p μ) :=
begin
  apply_instance -- sum of two p-integrable functions is p-integrable
end

-- If 1 ≤ p then it's a normed group
noncomputable example [fact (1 ≤ p)]: normed_add_comm_group (Lp F p μ) :=
begin
  sorry
end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.of_associative
import algebra.lie.ideal_operations

/-!
# Trivial Lie modules and Abelian Lie algebras

The action of a Lie algebra `L` on a module `M` is trivial if `⁅x, m⁆ = 0` for all `x ∈ L` and
`m ∈ M`. In the special case that `M = L` with the adjoint action, triviality corresponds to the
concept of an Abelian Lie algebra.

In this file we define these concepts and provide some related definitions and results.

## Main definitions

  * `lie_module.is_trivial`
  * `is_lie_abelian`
  * `commutative_ring_iff_abelian_lie_ring`
  * `lie_module.ker`
  * `lie_module.max_triv_submodule`
  * `lie_algebra.center`

## Tags

lie algebra, abelian, commutative, center
-/

universes u v w w₁ w₂

/-- A Lie (ring) module is trivial iff all brackets vanish. -/
class lie_module.is_trivial (L : Type v) (M : Type w) [has_bracket L M] [has_zero M] : Prop :=
(trivial : ∀ (x : L) (m : M), ⁅x, m⁆ = 0)

@[simp] lemma trivial_lie_zero (L : Type v) (M : Type w)
  [has_bracket L M] [has_zero M] [lie_module.is_trivial L M] (x : L) (m : M) : ⁅x, m⁆ = 0 :=
lie_module.is_trivial.trivial x m

/-- A Lie algebra is Abelian iff it is trivial as a Lie module over itself. -/
abbreviation is_lie_abelian (L : Type v) [has_bracket L L] [has_zero L] : Prop :=
lie_module.is_trivial L L

instance lie_ideal.is_lie_abelian_of_trivial (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L) [h : lie_module.is_trivial L I] :
  is_lie_abelian I :=
{ trivial := λ x y, by apply h.trivial, }

lemma function.injective.is_lie_abelian {R : Type u} {L₁ : Type v} {L₂ : Type w}
  [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]
  {f : L₁ →ₗ⁅R⁆ L₂} (h₁ : function.injective f) (h₂ : is_lie_abelian L₂) :
  is_lie_abelian L₁ :=
{ trivial := λ x y,
    by { apply h₁, rw [lie_hom.map_lie, trivial_lie_zero, lie_hom.map_zero], } }

lemma function.surjective.is_lie_abelian {R : Type u} {L₁ : Type v} {L₂ : Type w}
  [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]
  {f : L₁ →ₗ⁅R⁆ L₂} (h₁ : function.surjective f) (h₂ : is_lie_abelian L₁) :
  is_lie_abelian L₂ :=
{ trivial := λ x y,
    begin
      obtain ⟨u, hu⟩ := h₁ x, rw ← hu,
      obtain ⟨v, hv⟩ := h₁ y, rw ← hv,
      rw [← lie_hom.map_lie, trivial_lie_zero, lie_hom.map_zero],
    end }

lemma lie_abelian_iff_equiv_lie_abelian {R : Type u} {L₁ : Type v} {L₂ : Type w}
  [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]
  (e : L₁ ≃ₗ⁅R⁆ L₂) : is_lie_abelian L₁ ↔ is_lie_abelian L₂ :=
⟨e.symm.injective.is_lie_abelian, e.injective.is_lie_abelian⟩

lemma commutative_ring_iff_abelian_lie_ring {A : Type v} [ring A] :
  is_commutative A (*) ↔ is_lie_abelian A :=
begin
  have h₁ : is_commutative A (*) ↔ ∀ (a b : A), a * b = b * a := ⟨λ h, h.1, λ h, ⟨h⟩⟩,
  have h₂ : is_lie_abelian A ↔ ∀ (a b : A), ⁅a, b⁆ = 0 := ⟨λ h, h.1, λ h, ⟨h⟩⟩,
  simp only [h₁, h₂, lie_ring.of_associative_ring_bracket, sub_eq_zero],
end

lemma lie_algebra.is_lie_abelian_bot (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] : is_lie_abelian (⊥ : lie_ideal R L) :=
⟨begin
  rintros ⟨x, hx⟩ ⟨y, hy⟩,
  suffices : ⁅x, y⁆ = 0,
  { ext, simp only [this, lie_subalgebra.coe_bracket, submodule.coe_mk, submodule.coe_zero], },
  change x ∈ (⊥ : lie_ideal R L) at hx, rw lie_submodule.mem_bot at hx, rw [hx, zero_lie],
end⟩

section center

variables (R : Type u) (L : Type v) (M : Type w) (N : Type w₁)
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]

namespace lie_module

/-- The kernel of the action of a Lie algebra `L` on a Lie module `M` as a Lie ideal in `L`. -/
protected def ker : lie_ideal R L := (to_endomorphism R L M).ker

@[simp] protected

/-- The largest submodule of a Lie module `M` on which the Lie algebra `L` acts trivially. -/
def max_triv_submodule : lie_submodule R L M :=
{ carrier   := { m | ∀ (x : L), ⁅x, m⁆ = 0 },
  zero_mem' := λ x, lie_zero x,
  add_mem'  := λ x y hx hy z, by rw [lie_add, hx, hy, add_zero],
  smul_mem' := λ c x hx y, by rw [lie_smul, hx, smul_zero],
  lie_mem   := λ x m hm y, by rw [hm, lie_zero], }

@[simp] lemma mem_max_triv_submodule (m : M) :
  m ∈ max_triv_submodule R L M ↔ ∀ (x : L), ⁅x, m⁆ = 0 :=
iff.rfl

instance : is_trivial L (max_triv_submodule R L M) :=
{ trivial := λ x m, subtype.ext (m.property x), }

lemma trivial_iff_le_maximal_trivial (N : lie_submodule R L M) :
  is_trivial L N ↔ N ≤ max_triv_submodule R L M :=
begin
  split,
  { rintros ⟨h⟩, intros m hm x, specialize h x ⟨m, hm⟩, rw subtype.ext_iff at h, exact h, },
  { intros h, constructor, rintros x ⟨m, hm⟩, apply subtype.ext, apply h, exact hm, },
end

lemma is_trivial_iff_max_triv_eq_top :
  is_trivial L M ↔ max_triv_submodule R L M = ⊤ :=
begin
  split,
  { rintros ⟨h⟩, ext,
    simp only [mem_max_triv_submodule, h, forall_const, true_iff, eq_self_iff_true], },
  { intros h, constructor, intros x m, revert x,
    rw [← mem_max_triv_submodule R L M, h], exact lie_submodule.mem_top m, },
end

variables {R L M N}

/-- `max_triv_submodule` is functorial. -/
def max_triv_hom (f : M →ₗ⁅R,L⁆ N) :
  max_triv_submodule R L M →ₗ⁅R,L⁆ max_triv_submodule R L N :=
{ to_fun    := λ m, ⟨f m, λ x, by
    { have h := congr_arg f (m.property x),
      rw [lie_module_hom.map_zero, lie_module_hom.map_lie] at h, exact h, }⟩,
  map_add'  := λ m n, by simpa,
  map_smul' := λ t m, by simpa,
  map_lie'  := λ x m, by simp, }

@[norm_cast, simp] lemma coe_max_triv_hom_apply
  (f : M →ₗ⁅R,L⁆ N) (m : max_triv_submodule R L M) :
  (max_triv_hom f m : N) = f m :=
rfl

/-- The maximal trivial submodules of Lie-equivalent Lie modules are Lie-equivalent. -/
def max_triv_equiv (e : M ≃ₗ⁅R,L⁆ N) :
  max_triv_submodule R L M ≃ₗ⁅R,L⁆ max_triv_submodule R L N :=
{ to_fun    := max_triv_hom (e : M →ₗ⁅R,L⁆ N),
  inv_fun   := max_triv_hom (e.symm : N →ₗ⁅R,L⁆ M),
  left_inv  := λ m, by { ext, simp, },
  right_inv := λ n, by { ext, simp, },
  .. max_triv_hom (e : M →ₗ⁅R,L⁆ N), }

@[norm_cast, simp] lemma coe_max_triv_equiv_apply
  (e : M ≃ₗ⁅R,L⁆ N) (m : max_triv_submodule R L M) :
  (max_triv_equiv e m : N) = e ↑m :=
rfl

@[simp] lemma max_triv_equiv_of_refl_eq_refl :
  max_triv_equiv (lie_module_equiv.refl : M ≃ₗ⁅R,L⁆ M) = lie_module_equiv.refl :=
by { ext, simp only [coe_max_triv_equiv_apply, lie_module_equiv.refl_apply], }

@[simp] lemma max_triv_equiv_of_equiv_symm_eq_symm (e : M ≃ₗ⁅R,L⁆ N) :
  (max_triv_equiv e).symm = max_triv_equiv e.symm :=
rfl

/-- A linear map between two Lie modules is a morphism of Lie modules iff the Lie algebra action
on it is trivial. -/
def max_triv_linear_map_equiv_lie_module_hom :
  (max_triv_submodule R L (M →ₗ[R] N)) ≃ₗ[R] (M →ₗ⁅R,L⁆ N) :=
{ to_fun    := λ f,
    { map_lie' := λ x m, by
      { have hf : ⁅x, f.val⁆ m = 0, { rw [f.property x, linear_map.zero_apply], },
        rw [lie_hom.lie_apply, sub_eq_zero, ← linear_map.to_fun_eq_coe] at hf, exact hf.symm, },
      ..f.val, },
  map_add'  := λ f g, by { ext, simp, },
  map_smul' := λ F G, by { ext, simp, },
  inv_fun   := λ F, ⟨F, λ x, by { ext, simp, }⟩,
  left_inv  := λ f, by simp,
  right_inv := λ F, by simp, }

@[simp] lemma coe_max_triv_linear_map_equiv_lie_module_hom
  (f : max_triv_submodule R L (M →ₗ[R] N)) :
  ((max_triv_linear_map_equiv_lie_module_hom f) : M → N) = f :=
by { ext, refl, }

@[simp] lemma coe_max_triv_linear_map_equiv_lie_module_hom_symm
  (f : M →ₗ⁅R,L⁆ N) :
  ((max_triv_linear_map_equiv_lie_module_hom.symm f) : M → N) = f :=
rfl

@[simp] lemma coe_linear_map_max_triv_linear_map_equiv_lie_module_hom
  (f : max_triv_submodule R L (M →ₗ[R] N)) :
  ((max_triv_linear_map_equiv_lie_module_hom f) : M →ₗ[R] N) = (f : M →ₗ[R] N) :=
by { ext, refl, }

@[simp] lemma coe_linear_map_max_triv_linear_map_equiv_lie_module_hom_symm
  (f : M →ₗ⁅R,L⁆ N) :
  ((max_triv_linear_map_equiv_lie_module_hom.symm f) : M →ₗ[R] N) = (f : M →ₗ[R] N) :=
rfl

end lie_module

namespace lie_algebra

/-- The center of a Lie algebra is the set of elements that commute with everything. It can
be viewed as the maximal trivial submodule of the Lie algebra as a Lie module over itself via the
adjoint representation. -/
abbreviation center : lie_ideal R L := lie_module.max_triv_submodule R L L

instance : is_lie_abelian (center R L) := infer_instance

lemma center_eq_adjoint_kernel : center R L = lie_module.ker R L L :=
begin
  ext y,
  simp only [lie_module.mem_max_triv_submodule, lie_module.mem_ker,
    ← lie_skew _ y, neg_eq_zero],
end

lemma abelian_of_le_center (I : lie_ideal R L) (h : I ≤ center R L) : is_lie_abelian I :=
begin
  rw ← lie_module.trivial_iff_le_maximal_trivial R L L I at h,
  haveI := h, exact lie_ideal.is_lie_abelian_of_trivial R L I,
end

lemma is_lie_abelian_iff_center_eq_top : is_lie_abelian L ↔ center R L = ⊤ :=
lie_module.is_trivial_iff_max_triv_eq_top R L L

end lie_algebra

end center

section ideal_operations

open lie_submodule lie_subalgebra

variables {R : Type u} {L : Type v} {M : Type w}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]
variables (N N' : lie_submodule R L M) (I J : lie_ideal R L)

@[simp] lemma lie_submodule.trivial_lie_oper_zero [lie_module.is_trivial L M] : ⁅I, N⁆ = ⊥ :=
begin
  suffices : ⁅I, N⁆ ≤ ⊥, { exact le_bot_iff.mp this, },
  rw [lie_ideal_oper_eq_span, lie_submodule.lie_span_le],
  rintros m ⟨x, n, h⟩, rw trivial_lie_zero at h, simp [← h],
end

lemma lie_submodule.lie_abelian_iff_lie_self_eq_bot : is_lie_abelian I ↔ ⁅I, I⁆ = ⊥ :=
begin
  simp only [_root_.eq_bot_iff, lie_ideal_oper_eq_span, lie_submodule.lie_span_le,
    lie_submodule.bot_coe, set.subset_singleton_iff, set.mem_set_of_eq, exists_imp_distrib],
  split; intros h,
  { intros z x y hz, rw [← hz, ← coe_bracket, coe_zero_iff_zero], apply h.trivial, },
  { exact ⟨λ x y, by { rw ← coe_zero_iff_zero, apply h _ x y, refl, }⟩, },
end

end ideal_operations