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

import analysis.normed.group.hom
import analysis.normed.group.completion
/-!
# Completion of normed group homs

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

Given two (semi) normed groups `G` and `H` and a normed group hom `f : normed_add_group_hom G H`,
we build and study a normed group hom
`f.completion  : normed_add_group_hom (completion G) (completion H)` such that the diagram

```
                   f
     G       ----------->     H

     |                        |
     |                        |
     |                        |
     V                        V

completion G -----------> completion H
            f.completion
```

commutes. The map itself comes from the general theory of completion of uniform spaces, but here
we want a normed group hom, study its operator norm and kernel.

The vertical maps in the above diagrams are also normed group homs constructed in this file.

## Main definitions and results:

* `normed_add_group_hom.completion`: see the discussion above.
* `normed_add_comm_group.to_compl : normed_add_group_hom G (completion G)`: the canonical map from
  `G` to its completion, as a normed group hom
* `normed_add_group_hom.completion_to_compl`: the above diagram indeed commutes.
* `normed_add_group_hom.norm_completion`: `‖f.completion‖ = ‖f‖`
* `normed_add_group_hom.ker_le_ker_completion`: the kernel of `f.completion` contains the image of
  the kernel of `f`.
* `normed_add_group_hom.ker_completion`: the kernel of `f.completion` is the closure of the image of
  the kernel of `f` under an assumption that `f` is quantitatively surjective onto its image.
* `normed_add_group_hom.extension` : if `H` is complete, the extension of
  `f : normed_add_group_hom G H` to a `normed_add_group_hom (completion G) H`.
-/

noncomputable theory

open set normed_add_group_hom uniform_space

section completion

variables {G : Type*} [seminormed_add_comm_group G]
variables {H : Type*} [seminormed_add_comm_group H]
variables {K : Type*} [seminormed_add_comm_group K]

/-- The normed group hom induced between completions. -/
def normed_add_group_hom.completion (f : normed_add_group_hom G H) :
  normed_add_group_hom (completion G) (completion H) :=
{ bound' := begin
    use ‖f‖,
    intro y,
    apply completion.induction_on y,
    { exact is_closed_le
            (continuous_norm.comp $ f.to_add_monoid_hom.continuous_completion f.continuous)
            (continuous_const.mul continuous_norm) },
    { intro x,
      change ‖f.to_add_monoid_hom.completion _ ↑x‖ ≤ ‖f‖ * ‖↑x‖,
      rw f.to_add_monoid_hom.completion_coe f.continuous,
      simp only [completion.norm_coe],
      exact f.le_op_norm x }
  end,
  ..f.to_add_monoid_hom.completion f.continuous }

lemma normed_add_group_hom.completion_def (f : normed_add_group_hom G H) (x : completion G) :
  f.completion x = completion.map f x := rfl

@[simp]
lemma normed_add_group_hom.completion_coe_to_fun (f : normed_add_group_hom G H) :
  (f.completion : completion G → completion H) = completion.map f :=
by { ext x, exact normed_add_group_hom.completion_def f x }

@[simp]
lemma normed_add_group_hom.completion_coe (f : normed_add_group_hom G H) (g : G) :
  f.completion g = f g :=
completion.map_coe f.uniform_continuous _

/-- Completion of normed group homs as a normed group hom. -/
@[simps] def normed_add_group_hom_completion_hom :
  normed_add_group_hom G H →+ normed_add_group_hom (completion G) (completion H) :=
{ to_fun := normed_add_group_hom.completion,
  map_zero' := begin
    apply to_add_monoid_hom_injective,
    exact add_monoid_hom.completion_zero
  end,
  map_add' := λ f g, begin
    apply to_add_monoid_hom_injective,
    exact f.to_add_monoid_hom.completion_add g.to_add_monoid_hom f.continuous g.continuous,
  end }

@[simp]
lemma normed_add_group_hom.completion_id :
  (normed_add_group_hom.id G).completion = normed_add_group_hom.id (completion G) :=
begin
  ext x,
  rw [normed_add_group_hom.completion_def, normed_add_group_hom.coe_id, completion.map_id],
  refl
end

lemma normed_add_group_hom.completion_comp (f : normed_add_group_hom G H)
  (g : normed_add_group_hom H K) :
  g.completion.comp f.completion = (g.comp f).completion :=
begin
  ext x,
  rw [normed_add_group_hom.coe_comp, normed_add_group_hom.completion_def,
    normed_add_group_hom.completion_coe_to_fun, normed_add_group_hom.completion_coe_to_fun,
    completion.map_comp (normed_add_group_hom.uniform_continuous _)
    (normed_add_group_hom.uniform_continuous _)],
  refl
end

lemma normed_add_group_hom.completion_neg (f : normed_add_group_hom G H) :
  (-f).completion = -f.completion :=
map_neg (normed_add_group_hom_completion_hom : normed_add_group_hom G H →+ _) f

lemma normed_add_group_hom.completion_add (f g : normed_add_group_hom G H) :
  (f + g).completion = f.completion + g.completion :=
normed_add_group_hom_completion_hom.map_add f g

lemma normed_add_group_hom.completion_sub (f g : normed_add_group_hom G H) :
  (f - g).completion = f.completion - g.completion :=
map_sub (normed_add_group_hom_completion_hom : normed_add_group_hom G H →+ _) f g

@[simp]
lemma normed_add_group_hom.zero_completion : (0 : normed_add_group_hom G H).completion = 0 :=
normed_add_group_hom_completion_hom.map_zero

/-- The map from a normed group to its completion, as a normed group hom. -/
def normed_add_comm_group.to_compl : normed_add_group_hom G (completion G) :=
{ to_fun := coe,
  map_add' := completion.to_compl.map_add,
  bound' := ⟨1, by simp [le_refl]⟩ }

open normed_add_comm_group

lemma normed_add_comm_group.norm_to_compl (x : G) : ‖to_compl x‖ = ‖x‖ :=
completion.norm_coe x

lemma normed_add_comm_group.dense_range_to_compl : dense_range (to_compl : G → completion G) :=
completion.dense_inducing_coe.dense

@[simp]
lemma normed_add_group_hom.completion_to_compl (f : normed_add_group_hom G H) :
  f.completion.comp to_compl = to_compl.comp f :=
begin
  ext x,
  change f.completion x = _,
  simpa
end

@[simp] lemma normed_add_group_hom.norm_completion (f : normed_add_group_hom G H) :
  ‖f.completion‖ = ‖f‖ :=
begin
  apply f.completion.op_norm_eq_of_bounds (norm_nonneg _),
  { intro x,
    apply completion.induction_on x,
    { apply is_closed_le,
      continuity },
    { intro g,
      simp [f.le_op_norm  g] } },
  { intros N N_nonneg hN,
    apply f.op_norm_le_bound N_nonneg,
    intro x,
    simpa using hN x },
end

lemma normed_add_group_hom.ker_le_ker_completion (f : normed_add_group_hom G H) :
  (to_compl.comp $ incl f.ker).range ≤ f.completion.ker  :=
begin
  intros a h,
  replace h : ∃ y : f.ker, to_compl (y : G) = a, by simpa using h,
  rcases h with ⟨⟨g, g_in : g ∈ f.ker⟩, rfl⟩,
  rw f.mem_ker at g_in,
  change f.completion (g : completion G) = 0,
  simp [normed_add_group_hom.mem_ker, f.completion_coe g, g_in, completion.coe_zero],
end

lemma normed_add_group_hom.ker_completion {f : normed_add_group_hom G H} {C : ℝ}
  (h : f.surjective_on_with f.range C) :
  (f.completion.ker : set $ completion G) = closure (to_compl.comp $ incl f.ker).range :=
begin
  rcases h.exists_pos with ⟨C', C'_pos, hC'⟩,
  apply le_antisymm,
  { intros hatg hatg_in,
    rw seminormed_add_comm_group.mem_closure_iff,
    intros ε ε_pos,
    have hCf : 0 ≤ C'*‖f‖ := (zero_le_mul_left C'_pos).mpr (norm_nonneg f),
    have ineq : 0 < 1 + C'*‖f‖, by linarith,
    set δ := ε/(1 + C'*‖f‖),
    have δ_pos : δ > 0, from div_pos ε_pos ineq,
    obtain ⟨_, ⟨g : G, rfl⟩, hg : ‖hatg - g‖ < δ⟩ := seminormed_add_comm_group.mem_closure_iff.mp
      (completion.dense_inducing_coe.dense hatg) δ δ_pos,
    obtain ⟨g' : G, hgg' : f g' = f g, hfg : ‖g'‖ ≤ C' * ‖f g‖⟩ :=
      hC' (f g) (mem_range_self g),
    have mem_ker : g - g' ∈ f.ker,
      by rw [f.mem_ker, map_sub, sub_eq_zero.mpr hgg'.symm],
    have : ‖f g‖ ≤ ‖f‖*‖hatg - g‖,
    calc
      ‖f g‖ = ‖f.completion g‖ : by rw [f.completion_coe, completion.norm_coe]
        ... = ‖f.completion g - 0‖ : by rw [sub_zero _]
        ... = ‖f.completion g - (f.completion hatg)‖ : by rw [(f.completion.mem_ker _).mp hatg_in]
        ... = ‖f.completion (g - hatg)‖ : by rw [map_sub]
        ... ≤ ‖f.completion‖ * ‖(g :completion G) - hatg‖ : f.completion.le_op_norm _
        ... = ‖f‖ * ‖hatg - g‖ : by rw [norm_sub_rev, f.norm_completion],
    have : ‖(g' : completion G)‖ ≤ C'*‖f‖*‖hatg - g‖,
    calc
    ‖(g' : completion G)‖ = ‖g'‖ : completion.norm_coe _
                      ... ≤ C' * ‖f g‖ : hfg
                      ... ≤ C' * ‖f‖ * ‖hatg - g‖ : by { rw mul_assoc,
                                                        exact (mul_le_mul_left C'_pos).mpr this },
    refine ⟨g - g', _, _⟩,
    { norm_cast,
      rw normed_add_group_hom.comp_range,
      apply add_subgroup.mem_map_of_mem,
      simp only [incl_range, mem_ker] },
    { calc ‖hatg - (g - g')‖ = ‖hatg - g + g'‖ : by abel
      ... ≤ ‖hatg - g‖ + ‖(g' : completion G)‖ : norm_add_le _ _
      ... < δ + C'*‖f‖*‖hatg - g‖ : by linarith
      ... ≤ δ + C'*‖f‖*δ : add_le_add_left (mul_le_mul_of_nonneg_left hg.le hCf) δ
      ... = (1 + C'*‖f‖)*δ : by ring
      ... = ε : mul_div_cancel' _ ineq.ne.symm } },
  { rw ← f.completion.is_closed_ker.closure_eq,
    exact closure_mono f.ker_le_ker_completion }
end

end completion

section extension

variables {G : Type*} [seminormed_add_comm_group G]
variables {H : Type*} [seminormed_add_comm_group H] [separated_space H] [complete_space H]

/-- If `H` is complete, the extension of `f : normed_add_group_hom G H` to a
`normed_add_group_hom (completion G) H`. -/
def normed_add_group_hom.extension (f : normed_add_group_hom G H) :
  normed_add_group_hom (completion G) H :=
{ bound' := begin
    refine ⟨‖f‖, λ v, completion.induction_on v (is_closed_le _ _) (λ a, _)⟩,
    { exact continuous.comp continuous_norm completion.continuous_extension },
    { exact continuous.mul continuous_const continuous_norm },
    { rw [completion.norm_coe, add_monoid_hom.to_fun_eq_coe, add_monoid_hom.extension_coe],
      exact le_op_norm f a }
  end,
  ..f.to_add_monoid_hom.extension f.continuous }

lemma normed_add_group_hom.extension_def (f : normed_add_group_hom G H) (v : G) :
  f.extension v = completion.extension f v := rfl

@[simp] lemma normed_add_group_hom.extension_coe (f : normed_add_group_hom G H) (v : G) :
  f.extension v = f v := add_monoid_hom.extension_coe _ f.continuous _

lemma normed_add_group_hom.extension_coe_to_fun (f : normed_add_group_hom G H) :
  (f.extension : (completion G) → H) = completion.extension f := rfl

lemma normed_add_group_hom.extension_unique (f : normed_add_group_hom G H)
  {g : normed_add_group_hom (completion G) H} (hg : ∀ v, f v = g v) : f.extension = g :=
begin
  ext v,
  rw [normed_add_group_hom.extension_coe_to_fun, completion.extension_unique f.uniform_continuous
    g.uniform_continuous (λ a, hg a)]
end

end extension


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best
-/
import data.list.basic

/-!
# Sums and products from lists

This file provides basic results about `list.prod` and `list.sum`, which calculate the product and
sum of elements of a list. These are defined in [`data.list.defs`](./data/list/defs).
-/

variables {ι M N P M₀ G R : Type*}

namespace list
section monoid
variables [monoid M] [monoid N] [monoid P] {l l₁ l₂ : list M} {a : M}

@[simp, to_additive]
lemma prod_nil : ([] : list M).prod = 1 := rfl

@[to_additive]
lemma prod_singleton : [a].prod = a := one_mul a

@[simp, to_additive]
lemma prod_cons : (a :: l).prod = a * l.prod :=
calc (a :: l).prod = foldl (*) (a * 1) l : by simp only [list.prod, foldl_cons, one_mul, mul_one]
  ... = _ : foldl_assoc

@[simp, to_additive]
lemma prod_append : (l₁ ++ l₂).prod = l₁.prod * l₂.prod :=
calc (l₁ ++ l₂).prod = foldl (*) (foldl (*) 1 l₁ * 1) l₂ : by simp [list.prod]
  ... = l₁.prod * l₂.prod : foldl_assoc

@[to_additive]
lemma prod_concat : (l.concat a).prod = l.prod * a :=
by rw [concat_eq_append, prod_append, prod_singleton]

@[simp, to_additive]
lemma prod_join {l : list (list M)} : l.join.prod = (l.map list.prod).prod :=
by induction l; [refl, simp only [*, list.join, map, prod_append, prod_cons]]

@[to_additive]
lemma prod_eq_foldr : l.prod = foldr (*) 1 l :=
list.rec_on l rfl $ λ a l ihl, by rw [prod_cons, foldr_cons, ihl]

@[simp, priority 500, to_additive]
theorem prod_repeat (a : M) (n : ℕ) : (repeat a n).prod = a ^ n :=
begin
  induction n with n ih,
  { rw pow_zero, refl },
  { rw [list.repeat_succ, list.prod_cons, ih, pow_succ] }
end

@[to_additive sum_eq_card_nsmul]
lemma prod_eq_pow_card (l : list M) (m : M) (h : ∀ (x ∈ l), x = m) :
  l.prod = m ^ l.length :=
by rw [← prod_repeat, ← list.eq_repeat.mpr ⟨rfl, h⟩]

@[to_additive]
lemma prod_hom_rel (l : list ι) {r : M → N → Prop} {f : ι → M} {g : ι → N} (h₁ : r 1 1)
  (h₂ : ∀ ⦃i a b⦄, r a b → r (f i * a) (g i * b)) :
  r (l.map f).prod (l.map g).prod :=
list.rec_on l h₁ (λ a l hl, by simp only [map_cons, prod_cons, h₂ hl])

@[to_additive]
lemma prod_hom (l : list M) {F : Type*} [monoid_hom_class F M N] (f : F) :
  (l.map f).prod = f l.prod :=
by { simp only [prod, foldl_map, ← map_one f],
  exact l.foldl_hom _ _ _ 1 (map_mul f) }

@[to_additive]
lemma prod_hom₂ (l : list ι) (f : M → N → P)
  (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → M) (f₂ : ι → N) :
  (l.map $ λ i, f (f₁ i) (f₂ i)).prod = f (l.map f₁).prod (l.map f₂).prod :=
begin
  simp only [prod, foldl_map],
  convert l.foldl_hom₂ (λ a b, f a b) _ _ _ _ _ (λ a b i, _),
  { exact hf'.symm },
  { exact hf _ _ _ _ }
end

@[simp, to_additive]
lemma prod_map_mul {α : Type*} [comm_monoid α] {l : list ι} {f g : ι → α} :
  (l.map $ λ i, f i * g i).prod = (l.map f).prod * (l.map g).prod :=
l.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _

@[to_additive]
lemma prod_map_hom (L : list ι) (f : ι → M) {G : Type*} [monoid_hom_class G M N] (g : G) :
  (L.map (g ∘ f)).prod = g ((L.map f).prod) :=
by rw [← prod_hom, map_map]

@[to_additive]
lemma prod_is_unit : Π {L : list M} (u : ∀ m ∈ L, is_unit m), is_unit L.prod
| [] _ := by simp
| (h :: t) u :=
begin
  simp only [list.prod_cons],
  exact is_unit.mul (u h (mem_cons_self h t)) (prod_is_unit (λ m mt, u m (mem_cons_of_mem h mt)))
end

@[simp, to_additive]
lemma prod_take_mul_prod_drop :
  ∀ (L : list M) (i : ℕ), (L.take i).prod * (L.drop i).prod = L.prod
| [] i := by simp
| L 0 := by simp
| (h :: t) (n+1) := by { dsimp, rw [prod_cons, prod_cons, mul_assoc, prod_take_mul_prod_drop] }

@[simp, to_additive]
lemma prod_take_succ :
  ∀ (L : list M) (i : ℕ) (p), (L.take (i + 1)).prod = (L.take i).prod * L.nth_le i p
| [] i p := by cases p
| (h :: t) 0 _ := by simp
| (h :: t) (n+1) _ := by { dsimp, rw [prod_cons, prod_cons, prod_take_succ, mul_assoc] }

/-- A list with product not one must have positive length. -/
@[to_additive "A list with sum not zero must have positive length."]
lemma length_pos_of_prod_ne_one (L : list M) (h : L.prod ≠ 1) : 0 < L.length :=
by { cases L, { contrapose h, simp }, { simp } }

/-- A list with product greater than one must have positive length. -/
@[to_additive length_pos_of_sum_pos "A list with positive sum must have positive length."]
lemma length_pos_of_one_lt_prod [preorder M] (L : list M) (h : 1 < L.prod) :
  0 < L.length :=
length_pos_of_prod_ne_one L h.ne'

/-- A list with product less than one must have positive length. -/
@[to_additive "A list with negative sum must have positive length."]
lemma length_pos_of_prod_lt_one [preorder M] (L : list M) (h : L.prod < 1) :
  0 < L.length :=
length_pos_of_prod_ne_one L h.ne

@[to_additive]
lemma prod_update_nth : ∀ (L : list M) (n : ℕ) (a : M),
  (L.update_nth n a).prod =
    (L.take n).prod * (if n < L.length then a else 1) * (L.drop (n + 1)).prod
| (x :: xs) 0     a := by simp [update_nth]
| (x :: xs) (i+1) a := by simp [update_nth, prod_update_nth xs i a, mul_assoc]
| []      _     _ := by simp [update_nth, (nat.zero_le _).not_lt]

open mul_opposite

/-- We'd like to state this as `L.head * L.tail.prod = L.prod`, but because `L.head` relies on an
inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 1`.
-/
@[to_additive "We'd like to state this as `L.head + L.tail.sum = L.sum`, but because `L.head`
relies on an inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 0`."]
lemma nth_zero_mul_tail_prod (l : list M) : (l.nth 0).get_or_else 1 * l.tail.prod = l.prod :=
by cases l; simp

/-- Same as `nth_zero_mul_tail_prod`, but avoiding the `list.head` garbage complication by requiring
the list to be nonempty. -/
@[to_additive "Same as `nth_zero_add_tail_sum`, but avoiding the `list.head` garbage complication
by requiring the list to be nonempty."]
lemma head_mul_tail_prod_of_ne_nil [inhabited M] (l : list M) (h : l ≠ []) :
  l.head * l.tail.prod = l.prod :=
by cases l; [contradiction, simp]

@[to_additive]
lemma _root_.commute.list_prod_right (l : list M) (y : M) (h : ∀ (x ∈ l), commute y x) :
  commute y l.prod :=
begin
  induction l with z l IH,
  { simp },
  { rw list.ball_cons at h,
    rw list.prod_cons,
    exact commute.mul_right h.1 (IH h.2), }
end

@[to_additive]
lemma _root_.commute.list_prod_left (l : list M) (y : M) (h : ∀ (x ∈ l), commute x y) :
  commute l.prod y  :=
(commute.list_prod_right _ _ $ λ x hx, (h _ hx).symm).symm

lemma _root_.commute.list_sum_right [non_unital_non_assoc_semiring R] (a : R) (l : list R)
  (h : ∀ b ∈ l, commute a b) :
  commute a l.sum :=
begin
  induction l with x xs ih,
  { exact commute.zero_right _, },
  { rw sum_cons,
    exact (h _ $ mem_cons_self _ _).add_right (ih $ λ j hj, h _ $ mem_cons_of_mem _ hj) }
end

lemma _root_.commute.list_sum_left [non_unital_non_assoc_semiring R] (b : R) (l : list R)
  (h : ∀ a ∈ l, commute a b) :
  commute l.sum b :=
(commute.list_sum_right _ _ $ λ x hx, (h _ hx).symm).symm

@[to_additive sum_le_sum] lemma prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l : list ι} {f g : ι → M} (h : ∀ i ∈ l, f i ≤ g i) :
  (l.map f).prod ≤ (l.map g).prod :=
begin
  induction l with i l ihl, { refl },
  rw forall_mem_cons at h,
  simpa using mul_le_mul' h.1 (ihl h.2)
end

@[to_additive sum_lt_sum] lemma prod_lt_prod'
  [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)]
  [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)]
  {l : list ι} (f g : ι → M) (h₁ : ∀ i ∈ l, f i ≤ g i) (h₂ : ∃ i ∈ l, f i < g i) :
  (l.map f).prod < (l.map g).prod :=
begin
  induction l with i l ihl, { rcases h₂ with ⟨_, ⟨⟩, _⟩ },
  simp only [ball_cons, bex_cons, map_cons, prod_cons] at h₁ h₂ ⊢,
  cases h₂,
  exacts [mul_lt_mul_of_lt_of_le h₂ (prod_le_prod' h₁.2),
    mul_lt_mul_of_le_of_lt h₁.1 $ ihl h₁.2 h₂]
end

@[to_additive] lemma prod_lt_prod_of_ne_nil
  [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)]
  [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)]
  {l : list ι} (hl : l ≠ []) (f g : ι → M) (hlt : ∀ i ∈ l, f i < g i) :
  (l.map f).prod < (l.map g).prod :=
prod_lt_prod' f g (λ i hi, (hlt i hi).le) $ (exists_mem_of_ne_nil l hl).imp $ λ i hi, ⟨hi, hlt i hi⟩

@[to_additive sum_le_card_nsmul]
lemma prod_le_pow_card [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  (l : list M) (n : M) (h : ∀ (x ∈ l), x ≤ n) :
  l.prod ≤ n ^ l.length :=
by simpa only [map_id'', map_const, prod_repeat] using prod_le_prod' h

@[to_additive card_nsmul_le_sum]
lemma pow_card_le_prod [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  (l : list M) (n : M) (h : ∀ (x ∈ l), n ≤ x) :
  n ^ l.length ≤ l.prod :=
@prod_le_pow_card (order_dual M) _ _ _ _ l n h

@[to_additive exists_lt_of_sum_lt] lemma exists_lt_of_prod_lt' [linear_order M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] {l : list ι}
  (f g : ι → M) (h : (l.map f).prod < (l.map g).prod) :
  ∃ i ∈ l, f i < g i :=
by { contrapose! h, exact prod_le_prod' h }

@[to_additive exists_le_of_sum_le]
lemma exists_le_of_prod_le' [linear_order M] [covariant_class M M (*) (<)]
  [covariant_class M M (*) (≤)] [covariant_class M M (function.swap (*)) (<)]
  [covariant_class M M (function.swap (*)) (≤)] {l : list ι} (hl : l ≠ [])
  (f g : ι → M) (h : (l.map f).prod ≤ (l.map g).prod) :
  ∃ x ∈ l, f x ≤ g x :=
by { contrapose! h, exact prod_lt_prod_of_ne_nil hl _ _ h }

@[to_additive sum_nonneg]
lemma one_le_prod_of_one_le [preorder M] [covariant_class M M (*) (≤)] {l : list M}
  (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) :
  1 ≤ l.prod :=
begin
  -- We don't use `pow_card_le_prod` to avoid assumption
  -- [covariant_class M M (function.swap (*)) (≤)]
  induction l with hd tl ih, { refl },
  rw prod_cons,
  exact one_le_mul (hl₁ hd (mem_cons_self hd tl)) (ih (λ x h, hl₁ x (mem_cons_of_mem hd h)))
end

end monoid

section monoid_with_zero

variables [monoid_with_zero M₀]

/-- If zero is an element of a list `L`, then `list.prod L = 0`. If the domain is a nontrivial
monoid with zero with no divisors, then this implication becomes an `iff`, see
`list.prod_eq_zero_iff`. -/
lemma prod_eq_zero {L : list M₀} (h : (0 : M₀) ∈ L) : L.prod = 0 :=
begin
  induction L with a L ihL,
  { exact absurd h (not_mem_nil _) },
  { rw prod_cons,
    cases (mem_cons_iff _ _ _).1 h with ha hL,
    exacts [mul_eq_zero_of_left ha.symm _, mul_eq_zero_of_right _ (ihL hL)] }
end

/-- Product of elements of a list `L` equals zero if and only if `0 ∈ L`. See also
`list.prod_eq_zero` for an implication that needs weaker typeclass assumptions. -/
@[simp] lemma prod_eq_zero_iff [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} :
  L.prod = 0 ↔ (0 : M₀) ∈ L :=
begin
  induction L with a L ihL,
  { simp },
  { rw [prod_cons, mul_eq_zero, ihL, mem_cons_iff, eq_comm] }
end

lemma prod_ne_zero [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} (hL : (0 : M₀) ∉ L) :
  L.prod ≠ 0 :=
mt prod_eq_zero_iff.1 hL

end monoid_with_zero

section group
variables [group G]

/-- This is the `list.prod` version of `mul_inv_rev` -/
@[to_additive "This is the `list.sum` version of `add_neg_rev`"]
lemma prod_inv_reverse : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).reverse.prod
| [] := by simp
| (x :: xs) := by simp [prod_inv_reverse xs]

/-- A non-commutative variant of `list.prod_reverse` -/
@[to_additive "A non-commutative variant of `list.sum_reverse`"]
lemma prod_reverse_noncomm : ∀ (L : list G), L.reverse.prod = (L.map (λ x, x⁻¹)).prod⁻¹ :=
by simp [prod_inv_reverse]

/-- Counterpart to `list.prod_take_succ` when we have an inverse operation -/
@[simp, to_additive /-"Counterpart to `list.sum_take_succ` when we have an negation operation"-/]
lemma prod_drop_succ :
  ∀ (L : list G) (i : ℕ) (p), (L.drop (i + 1)).prod = (L.nth_le i p)⁻¹ * (L.drop i).prod
| [] i p := false.elim (nat.not_lt_zero _ p)
| (x :: xs) 0 p := by simp
| (x :: xs) (i + 1) p := prod_drop_succ xs i _

end group

section comm_group
variables [comm_group G]

/-- This is the `list.prod` version of `mul_inv` -/
@[to_additive "This is the `list.sum` version of `add_neg`"]
lemma prod_inv : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).prod
| [] := by simp
| (x :: xs) := by simp [mul_comm, prod_inv xs]

/-- Alternative version of `list.prod_update_nth` when the list is over a group -/
@[to_additive /-"Alternative version of `list.sum_update_nth` when the list is over a group"-/]
lemma prod_update_nth' (L : list G) (n : ℕ) (a : G) :
  (L.update_nth n a).prod =
    L.prod * (if hn : n < L.length then (L.nth_le n hn)⁻¹ * a else 1) :=
begin
  refine (prod_update_nth L n a).trans _,
  split_ifs with hn hn,
  { rw [mul_comm _ a, mul_assoc a, prod_drop_succ L n hn, mul_comm _ (drop n L).prod,
      ← mul_assoc (take n L).prod, prod_take_mul_prod_drop, mul_comm a, mul_assoc] },
  { simp only [take_all_of_le (le_of_not_lt hn), prod_nil, mul_one,
      drop_eq_nil_of_le ((le_of_not_lt hn).trans n.le_succ)] }
end

end comm_group

@[to_additive]
lemma eq_of_prod_take_eq [left_cancel_monoid M] {L L' : list M} (h : L.length = L'.length)
  (h' : ∀ i ≤ L.length, (L.take i).prod = (L'.take i).prod) : L = L' :=
begin
  apply ext_le h (λ i h₁ h₂, _),
  have : (L.take (i + 1)).prod = (L'.take (i + 1)).prod := h' _ (nat.succ_le_of_lt h₁),
  rw [prod_take_succ L i h₁, prod_take_succ L' i h₂, h' i (le_of_lt h₁)] at this,
  convert mul_left_cancel this
end

@[to_additive]
lemma monotone_prod_take [canonically_ordered_monoid M] (L : list M) :
  monotone (λ i, (L.take i).prod) :=
begin
  apply monotone_nat_of_le_succ (λ n, _),
  cases lt_or_le n L.length with h h,
  { rw prod_take_succ _ _ h,
    exact le_self_mul },
  { simp [take_all_of_le h, take_all_of_le (le_trans h (nat.le_succ _))] }
end

@[to_additive sum_pos]
lemma one_lt_prod_of_one_lt [ordered_comm_monoid M] :
  ∀ (l : list M) (hl : ∀ x ∈ l, (1 : M) < x) (hl₂ : l ≠ []), 1 < l.prod
| [] _ h := (h rfl).elim
| [b] h _ := by simpa using h
| (a :: b :: l) hl₁ hl₂ :=
begin
  simp only [forall_eq_or_imp, list.mem_cons_iff _ a] at hl₁,
  rw list.prod_cons,
  apply one_lt_mul_of_lt_of_le' hl₁.1,
  apply le_of_lt ((b :: l).one_lt_prod_of_one_lt hl₁.2 (l.cons_ne_nil b)),
end

@[to_additive]
lemma single_le_prod [ordered_comm_monoid M] {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) :
  ∀ x ∈ l, x ≤ l.prod :=
begin
  induction l,
  { simp },
  simp_rw [prod_cons, forall_mem_cons] at ⊢ hl₁,
  split,
  { exact le_mul_of_one_le_right' (one_le_prod_of_one_le hl₁.2) },
  { exact λ x H, le_mul_of_one_le_of_le hl₁.1 (l_ih hl₁.right x H) },
end

@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero]
lemma all_one_of_le_one_le_of_prod_eq_one [ordered_comm_monoid M]
  {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) (hl₂ : l.prod = 1) {x : M} (hx : x ∈ l) :
  x = 1 :=
le_antisymm (hl₂ ▸ single_le_prod hl₁ _ hx) (hl₁ x hx)

@[to_additive] lemma prod_eq_one_iff [canonically_ordered_monoid M] (l : list M) :
  l.prod = 1 ↔ ∀ x ∈ l, x = (1 : M) :=
⟨all_one_of_le_one_le_of_prod_eq_one (λ _ _, one_le _),
begin
  induction l,
  { simp },
  { intro h,
    rw [prod_cons, mul_eq_one_iff],
    rw forall_mem_cons at h,
    exact ⟨h.1, l_ih h.2⟩ },
end⟩

/-- If all elements in a list are bounded below by `1`, then the length of the list is bounded
by the sum of the elements. -/
lemma length_le_sum_of_one_le (L : list ℕ) (h : ∀ i ∈ L, 1 ≤ i) : L.length ≤ L.sum :=
begin
  induction L with j L IH h, { simp },
  rw [sum_cons, length, add_comm],
  exact add_le_add (h _ (set.mem_insert _ _)) (IH (λ i hi, h i (set.mem_union_right _ hi)))
end

-- TODO: develop theory of tropical rings
lemma sum_le_foldr_max [add_monoid M] [add_monoid N] [linear_order N] (f : M → N)
  (h0 : f 0 ≤ 0) (hadd : ∀ x y, f (x + y) ≤ max (f x) (f y)) (l : list M) :
  f l.sum ≤ (l.map f).foldr max 0 :=
begin
  induction l with hd tl IH,
  { simpa using h0 },
  simp only [list.sum_cons, list.foldr_map, list.foldr] at IH ⊢,
  exact (hadd _ _).trans (max_le_max le_rfl IH)
end

@[simp, to_additive]
lemma prod_erase [decidable_eq M] [comm_monoid M] {a} :
  ∀ {l : list M}, a ∈ l → a * (l.erase a).prod = l.prod
| (b :: l) h :=
  begin
    obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h,
    { simp only [list.erase, if_pos, prod_cons] },
    { simp only [list.erase, if_neg (mt eq.symm ne), prod_cons, prod_erase h, mul_left_comm a b] }
  end

lemma dvd_prod [comm_monoid M] {a} {l : list M} (ha : a ∈ l) : a ∣ l.prod :=
let ⟨s, t, h⟩ := mem_split ha in
by { rw [h, prod_append, prod_cons, mul_left_comm], exact dvd_mul_right _ _ }

@[simp] lemma sum_const_nat (m n : ℕ) : sum (list.repeat m n) = m * n :=
by induction n; [refl, simp only [*, repeat_succ, sum_cons, nat.mul_succ, add_comm]]

lemma dvd_sum [semiring R] {a} {l : list R} (h : ∀ x ∈ l, a ∣ x) : a ∣ l.sum :=
begin
  induction l with x l ih,
  { exact dvd_zero _ },
  { rw [list.sum_cons],
    exact dvd_add (h _ (mem_cons_self _ _)) (ih (λ x hx, h x (mem_cons_of_mem _ hx))) }
end

/-- The product of a list of positive natural numbers is positive,
and likewise for any nontrivial ordered semiring. -/
lemma prod_pos [ordered_semiring R] [nontrivial R] (l : list R) (h : ∀ a ∈ l, (0 : R) < a) :
  0 < l.prod :=
begin
  induction l with a l ih,
  { simp },
  { rw prod_cons,
    exact mul_pos (h _ $ mem_cons_self _ _) (ih $ λ a ha, h a $ mem_cons_of_mem _ ha) }
end

/-!
Several lemmas about sum/head/tail for `list ℕ`.
These are hard to generalize well, as they rely on the fact that `default ℕ = 0`.
If desired, we could add a class stating that `default = 0`.
-/

/-- This relies on `default ℕ = 0`. -/
lemma head_add_tail_sum (L : list ℕ) : L.head + L.tail.sum = L.sum :=
by { cases L, { simp, refl }, { simp } }

/-- This relies on `default ℕ = 0`. -/
lemma head_le_sum (L : list ℕ) : L.head ≤ L.sum := nat.le.intro (head_add_tail_sum L)

/-- This relies on `default ℕ = 0`. -/
lemma tail_sum (L : list ℕ) : L.tail.sum = L.sum - L.head :=
by rw [← head_add_tail_sum L, add_comm, add_tsub_cancel_right]

section alternating
variables [comm_group G]

@[simp, to_additive] lemma alternating_prod_nil : alternating_prod ([] : list G) = 1 := rfl

@[simp, to_additive] lemma alternating_prod_singleton (g : G) : alternating_prod [g] = g := rfl

@[simp, to_additive alternating_sum_cons_cons']
lemma alternating_prod_cons_cons (g h : G) (l : list G) :
  alternating_prod (g :: h :: l) = g * h⁻¹ * alternating_prod l := rfl

lemma alternating_sum_cons_cons {G : Type*} [add_comm_group G] (g h : G) (l : list G) :
  alternating_sum (g :: h :: l) = g - h + alternating_sum l :=
by rw [sub_eq_add_neg, alternating_sum]

end alternating

lemma sum_map_mul_left [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) :
  (L.map (λ b, r * f b)).sum = r * (L.map f).sum :=
sum_map_hom L f $ add_monoid_hom.mul_left r

lemma sum_map_mul_right [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) :
  (L.map (λ b, f b * r)).sum = (L.map f).sum * r :=
sum_map_hom L f $ add_monoid_hom.mul_right r

end list

namespace mul_opposite

open list
variables [monoid M]

lemma op_list_prod : ∀ (l : list M), op (l.prod) = (l.map op).reverse.prod
| [] := rfl
| (x :: xs) := by rw [list.prod_cons, list.map_cons, list.reverse_cons', list.prod_concat, op_mul,
                      op_list_prod]

lemma _root_.mul_opposite.unop_list_prod (l : list Mᵐᵒᵖ) :
  (l.prod).unop = (l.map unop).reverse.prod :=
by rw [← op_inj, op_unop, mul_opposite.op_list_prod, map_reverse, map_map, reverse_reverse,
  op_comp_unop, map_id]

end mul_opposite

section monoid_hom

variables [monoid M] [monoid N]

@[to_additive]
lemma map_list_prod {F : Type*} [monoid_hom_class F M N] (f : F)
  (l : list M) : f l.prod = (l.map f).prod :=
(l.prod_hom f).symm

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. -/
lemma unop_map_list_prod {F : Type*} [monoid_hom_class F M Nᵐᵒᵖ] (f : F) (l : list M) :
  (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod :=
by rw [map_list_prod f l, mul_opposite.unop_list_prod, list.map_map]

namespace monoid_hom

/-- Deprecated, use `_root_.map_list_prod` instead. -/
@[to_additive "Deprecated, use `_root_.map_list_sum` instead."]
protected lemma map_list_prod (f : M →* N) (l : list M) :
  f l.prod = (l.map f).prod :=
map_list_prod f l

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements.

Deprecated, use `_root_.unop_map_list_prod` instead. -/
protected lemma unop_map_list_prod (f : M →* Nᵐᵒᵖ) (l : list M) :
  (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod :=
unop_map_list_prod f l

end monoid_hom

end monoid_hom


structure point := (x y : nat)

#check point.mk 1 2

lemma point_destruct (p₁ p₂ : point) : p₁ = p₂ → p₁.x = p₂.x ∧ p₁.y = p₂.y := by {
  intro h,
  -- split; congr; exact h,
  split; {
    apply congr_arg,
    exact h,
  },
}

#check point.x
#check point.y

#check @congr_arg

lemma point_destruct' (p₁ p₂ : point) :
  p₁ = p₂ → p₁.x = p₂.x ∧ p₁.y = p₂.y := λ h, ⟨congr_arg point.x h, congr_arg point.y h⟩

#print point_destruct -- <=> point_destruct'

def point_arg {f : point → ℕ} {p₁ p₂ : point} :
  p₁ = p₂ → f p₁ = f p₂ := λ h, @congr_arg _ _ p₁ p₂ f h

#check @congr_arg -- ∀ {α : Sort u_1} {β : Sort u_2} {a₁ a₂ : α} (f : α → β), a₁ = a₂ → f a₁ = f a₂
#check @point_arg --                      ∀ {f : point → ℕ} {p₁ p₂ : point}, p₁ = p₂ → f p₁ = f p₂

#check point_arg _

lemma point_destruct'' (p₁ p₂ : point) (h : p₁ = p₂) :
  p₁.x = p₂.x ∧ p₁.y = p₂.y := and.intro (point_arg h) (point_arg h)
-- branches: 1. (point_arg h) 2. (point_arg h) are equal each other.
-- Can we use this fact to simplify proof?
-- answers:
-- 0. Using notation keyword
-- 1. Using lemma keyword
-- 2. Using repeat tactic
-- 3. Using way like that: def helper {p : Prop} (hp : p) : p ∧ p := and.intro hp hp
#check @point_arg
#check @point.x

-- p.x <=> point.x p
lemma lemma1 (p q : point) (h : p = q) : point.y p = point.y q := point_arg h
lemma lemma2 {p q : point} {f : point → ℕ} (h : p = q) : f p = f q := point_arg h
-- maybe we should add one more argument to lemma2 => lemma2 !== point_arg

lemma point_destruct''_1 (p₁ p₂ : point) (h : p₁ = p₂) :
  p₁.x = p₂.x ∧ p₁.y = p₂.y := by {
    apply and.intro,
    apply lemma2 h, -- lemma2 <=> point_arg, nothing new => wrong branch
    apply lemma2 h,
  }

-- Using repeat or iterate tactic:
lemma point_destruct''_2 (p₁ p₂ : point) (h : p₁ = p₂) :
  p₁.x = p₂.x ∧ p₁.y = p₂.y := by { apply and.intro, iterate 2 { exact point_arg h }, }

def helper {p : Prop} (hp : p) : p ∧ p := and.intro hp hp

#print helper

-- helper h has type
--   p₁ = p₂ ∧ p₁ = p₂
-- but is expected to have type
--   p₁.x = p₂.x ∧ p₁.y = p₂.y

-- def helper2 (f g : point → ℕ) (rel : point → point → Prop) := refl.

constant rel : point → point → Prop
axiom rel.refl (p : point) : rel p p

axiom congf (α β : Type) (a b : α) (f : α → β) : a = b → f a = f b

-- f = point.x, g = point.y
def helper2 (f g : point → ℕ) (rel : point → point → Prop) := rel.
#check helper2

#print point_destruct''

#check @and.intro
lemma point_destruct'''_1 (p₁ p₂ : point) (h : p₁ = p₂) :
  p₁.x = p₂.x ∧ p₁.y = p₂.y := by {
    apply eq.subst h,
    apply and.intro,
    repeat { exact eq.refl _, },
  }

lemma point_destruct'''_2 (p₁ p₂ : point) (h : p₁ = p₂) :
  p₁.x = p₂.x ∧ p₁.y = p₂.y := h ▸ (and.intro rfl rfl)

-- example of "meta test driven development" and simple: what is operator ▸ ?
-- example (h X : Prop) : h ▸ X = eq.subst h X := sorry

  -- (λ h₂, and.intro h₂ h₂) (point_arg h)

  -- by {
  --   apply helper,
  --   apply point_arg h,
  --   apply point_arg h,
  -- }

#print point_destruct'''

/-
λ (p₁ p₂ : point) (h : p₁ = p₂),
  ⟨(λ (c c_1 : point) (e_1 : c = c_1), congr_arg point.x e_1) p₁ p₂ h,
   (λ (c c_1 : point) (e_1 : c = c_1), congr_arg point.y e_1) p₁ p₂ h⟩
-/

-- Π {C : point → Sort ?} (n : point), (Π (x y : ℕ), C {x := x, y := y}) → C n
example : Prop = Sort 0 := rfl

example (a b c : ℕ) : a * b + b * c = b * (a + c) := by {
  have distrib : ∀ a b c : ℕ, a * (b + c) = a * b + a * c := sorry,
  have add_assoc : ∀ a b c : ℕ, a + (b + c) = (a + b) + c := sorry,
  have mul_assoc : ∀ a b c : ℕ, a * (b * c) = (a * b) * c := sorry,
  have add_comm : ∀ a b : ℕ, a + b = b + a := sorry,
  have mul_comm : ∀ a b : ℕ, a * b = b * a := sorry,
  have mul_zero : ∀ a : ℕ, a * 0 = 0 := sorry,

  sorry,
}


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.perm
import Mathlib.data.list.chain
import Mathlib.PostPort

universes u_1 uu

namespace Mathlib

/-!
# Sorting algorithms on lists

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

namespace list

/-!
### The predicate `list.sorted`
-/

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted {α : Type u_1} (R : α → α → Prop) : List α → Prop := pairwise

protected instance decidable_sorted {α : Type uu} {r : α → α → Prop} [DecidableRel r] (l : List α) :
    Decidable (sorted r l) :=
  list.decidable_pairwise l

@[simp] theorem sorted_nil {α : Type uu} {r : α → α → Prop} : sorted r [] := pairwise.nil

theorem sorted_of_sorted_cons {α : Type uu} {r : α → α → Prop} {a : α} {l : List α} :
    sorted r (a :: l) → sorted r l :=
  pairwise_of_pairwise_cons

theorem sorted.tail {α : Type uu} {r : α → α → Prop} {l : List α} (h : sorted r l) :
    sorted r (tail l) :=
  pairwise.tail h

theorem rel_of_sorted_cons {α : Type uu} {r : α → α → Prop} {a : α} {l : List α} :
    sorted r (a :: l) → ∀ (b : α), b ∈ l → r a b :=
  rel_of_pairwise_cons

@[simp] theorem sorted_cons {α : Type uu} {r : α → α → Prop} {a : α} {l : List α} :
    sorted r (a :: l) ↔ (∀ (b : α), b ∈ l → r a b) ∧ sorted r l :=
  pairwise_cons

protected theorem sorted.nodup {α : Type uu} {r : α → α → Prop} [is_irrefl α r] {l : List α}
    (h : sorted r l) : nodup l :=
  pairwise.nodup h

theorem eq_of_perm_of_sorted {α : Type uu} {r : α → α → Prop} [is_antisymm α r] {l₁ : List α}
    {l₂ : List α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
  sorry

@[simp] theorem sorted_singleton {α : Type uu} {r : α → α → Prop} (a : α) : sorted r [a] :=
  pairwise_singleton r a

theorem nth_le_of_sorted_of_le {α : Type uu} {r : α → α → Prop} [is_refl α r] {l : List α}
    (h : sorted r l) {a : ℕ} {b : ℕ} {ha : a < length l} {hb : b < length l} (hab : a ≤ b) :
    r (nth_le l a ha) (nth_le l b hb) :=
  or.dcases_on (eq_or_lt_of_le hab)
    (fun (H : a = b) => eq.drec (fun (hab : a ≤ a) => refl (nth_le l a ha)) H hb hab)
    fun (H : a < b) => iff.mp pairwise_iff_nth_le h a b hb H

/-! ### Insertion sort -/

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) :
    List α → List α :=
  sorry

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] : List α → List α :=
  sorry

@[simp] theorem ordered_insert_nil {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) :
    ordered_insert r a [] = [a] :=
  rfl

theorem ordered_insert_length {α : Type uu} (r : α → α → Prop) [DecidableRel r] (L : List α)
    (a : α) : length (ordered_insert r a L) = length L + 1 :=
  sorry

/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
theorem ordered_insert_eq_take_drop {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α)
    (l : List α) :
    ordered_insert r a l =
        take_while (fun (b : α) => ¬r a b) l ++ a :: drop_while (fun (b : α) => ¬r a b) l :=
  sorry

theorem insertion_sort_cons_eq_take_drop {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α)
    (l : List α) :
    insertion_sort r (a :: l) =
        take_while (fun (b : α) => ¬r a b) (insertion_sort r l) ++
          a :: drop_while (fun (b : α) => ¬r a b) (insertion_sort r l) :=
  ordered_insert_eq_take_drop r a (insertion_sort r l)

theorem perm_ordered_insert {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) :
    ordered_insert r a l ~ a :: l :=
  sorry

theorem ordered_insert_count {α : Type uu} (r : α → α → Prop) [DecidableRel r] [DecidableEq α]
    (L : List α) (a : α) (b : α) : count a (ordered_insert r b L) = count a L + ite (a = b) 1 0 :=
  sorry

theorem perm_insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) :
    insertion_sort r l ~ l :=
  sorry

/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
theorem sorted.insertion_sort_eq {α : Type uu} {r : α → α → Prop} [DecidableRel r] {l : List α}
    (h : sorted r l) : insertion_sort r l = l :=
  sorry

theorem sorted.ordered_insert {α : Type uu} {r : α → α → Prop} [DecidableRel r] [is_total α r]
    [is_trans α r] (a : α) (l : List α) : sorted r l → sorted r (ordered_insert r a l) :=
  sorry

/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r]
    [is_trans α r] (l : List α) : sorted r (insertion_sort r l) :=
  sorry

/-! ### Merge sort -/

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the

-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split {α : Type uu} : List α → List α × List α := sorry

theorem split_cons_of_eq {α : Type uu} (a : α) {l : List α} {l₁ : List α} {l₂ : List α}
    (h : split l = (l₁, l₂)) : split (a :: l) = (a :: l₂, l₁) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (split (a :: l) = (a :: l₂, l₁))) (split.equations._eqn_2 a l)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (split._match_1 a (split l) = (a :: l₂, l₁))) h))
      (Eq.refl (split._match_1 a (l₁, l₂))))

theorem length_split_le {α : Type uu} {l : List α} {l₁ : List α} {l₂ : List α} :
    split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l :=
  sorry

theorem length_split_lt {α : Type uu} {a : α} {b : α} {l : List α} {l₁ : List α} {l₂ : List α}
    (h : split (a :: b :: l) = (l₁, l₂)) :
    length l₁ < length (a :: b :: l) ∧ length l₂ < length (a :: b :: l) :=
  sorry

theorem perm_split {α : Type uu} {l : List α} {l₁ : List α} {l₂ : List α} :
    split l = (l₁, l₂) → l ~ l₁ ++ l₂ :=
  sorry

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge {α : Type uu} (r : α → α → Prop) [DecidableRel r] : List α → List α → List α := sorry

/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] : List α → List α := sorry

theorem merge_sort_cons_cons {α : Type uu} (r : α → α → Prop) [DecidableRel r] {a : α} {b : α}
    {l : List α} {l₁ : List α} {l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) :
    merge_sort r (a :: b :: l) = merge r (merge_sort r l₁) (merge_sort r l₂) :=
  sorry

theorem perm_merge {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) (l' : List α) :
    merge r l l' ~ l ++ l' :=
  sorry

theorem perm_merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) :
    merge_sort r l ~ l :=
  sorry

@[simp] theorem length_merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) :
    length (merge_sort r l) = length l :=
  perm.length_eq (perm_merge_sort r l)

theorem sorted.merge {α : Type uu} {r : α → α → Prop} [DecidableRel r] [is_total α r] [is_trans α r]
    {l : List α} {l' : List α} : sorted r l → sorted r l' → sorted r (merge r l l') :=
  sorry

theorem sorted_merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r]
    [is_trans α r] (l : List α) : sorted r (merge_sort r l) :=
  sorry

theorem merge_sort_eq_self {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r]
    [is_trans α r] [is_antisymm α r] {l : List α} : sorted r l → merge_sort r l = l :=
  eq_of_perm_of_sorted (perm_merge_sort r l) (sorted_merge_sort r l)

theorem merge_sort_eq_insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r]
    [is_total α r] [is_trans α r] [is_antisymm α r] (l : List α) :
    merge_sort r l = insertion_sort r l :=
  eq_of_perm_of_sorted (perm.trans (perm_merge_sort r l) (perm.symm (perm_insertion_sort r l)))
    (sorted_merge_sort r l) (sorted_insertion_sort r l)

end Mathlib


/-
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.solvable
import algebra.lie.quotient
import algebra.lie.centralizer
import linear_algebra.eigenspace
import ring_theory.nilpotent

/-!
# Nilpotent Lie algebras

Like groups, Lie algebras admit a natural concept of nilpotency. More generally, any Lie module
carries a natural concept of nilpotency. We define these here via the lower central series.

## Main definitions

  * `lie_module.lower_central_series`
  * `lie_module.is_nilpotent`

## Tags

lie algebra, lower central series, nilpotent
-/

universes u v w w₁ w₂

section nilpotent_modules

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 (k : ℕ) (N : lie_submodule R L M)

namespace lie_submodule

/-- A generalisation of the lower central series. The zeroth term is a specified Lie submodule of
a Lie module. In the case when we specify the top ideal `⊤` of the Lie algebra, regarded as a Lie
module over itself, we get the usual lower central series of a Lie algebra.

It can be more convenient to work with this generalisation when considering the lower central series
of a Lie submodule, regarded as a Lie module in its own right, since it provides a type-theoretic
expression of the fact that the terms of the Lie submodule's lower central series are also Lie
submodules of the enclosing Lie module.

See also `lie_module.lower_central_series_eq_lcs_comap` and
`lie_module.lower_central_series_map_eq_lcs` below, as well as `lie_submodule.ucs`. -/
def lcs : lie_submodule R L M → lie_submodule R L M := (λ N, ⁅(⊤ : lie_ideal R L), N⁆)^[k]

@[simp] lemma lcs_zero (N : lie_submodule R L M) : N.lcs 0 = N := rfl

@[simp] lemma lcs_succ : N.lcs (k + 1) = ⁅(⊤ : lie_ideal R L), N.lcs k⁆ :=
function.iterate_succ_apply' (λ N', ⁅⊤, N'⁆) k N

end lie_submodule

namespace lie_module

variables (R L M)

/-- The lower central series of Lie submodules of a Lie module. -/
def lower_central_series : lie_submodule R L M := (⊤ : lie_submodule R L M).lcs k

@[simp] lemma lower_central_series_zero : lower_central_series R L M 0 = ⊤ := rfl

@[simp] lemma lower_central_series_succ :
  lower_central_series R L M (k + 1) = ⁅(⊤ : lie_ideal R L), lower_central_series R L M k⁆ :=
(⊤ : lie_submodule R L M).lcs_succ k

end lie_module

namespace lie_submodule

open lie_module

variables {R L M}

lemma lcs_le_self : N.lcs k ≤ N :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lcs_succ],
    exact (lie_submodule.mono_lie_right _ _ ⊤ ih).trans (N.lie_le_right ⊤), },
end

lemma lower_central_series_eq_lcs_comap :
  lower_central_series R L N k = (N.lcs k).comap N.incl :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lcs_succ, lower_central_series_succ] at ⊢ ih,
    have : N.lcs k ≤ N.incl.range,
    { rw N.range_incl,
      apply lcs_le_self, },
    rw [ih, lie_submodule.comap_bracket_eq _ _ N.incl N.ker_incl this], },
end

lemma lower_central_series_map_eq_lcs :
  (lower_central_series R L N k).map N.incl = N.lcs k :=
begin
  rw [lower_central_series_eq_lcs_comap, lie_submodule.map_comap_incl, inf_eq_right],
  apply lcs_le_self,
end

end lie_submodule

namespace lie_module

variables (R L M)

lemma antitone_lower_central_series : antitone $ lower_central_series R L M :=
begin
  intros l k,
  induction k with k ih generalizing l;
  intros h,
  { exact (le_zero_iff.mp h).symm ▸ le_rfl, },
  { rcases nat.of_le_succ h with hk | hk,
    { rw lower_central_series_succ,
      exact (lie_submodule.mono_lie_right _ _ ⊤ (ih hk)).trans (lie_submodule.lie_le_right _ _), },
    { exact hk.symm ▸ le_rfl, }, },
end

lemma trivial_iff_lower_central_eq_bot : is_trivial L M ↔ lower_central_series R L M 1 = ⊥ :=
begin
  split; intros h,
  { erw [eq_bot_iff, lie_submodule.lie_span_le], rintros m ⟨x, n, hn⟩, rw [← hn, h.trivial], simp,},
  { rw lie_submodule.eq_bot_iff at h, apply is_trivial.mk, intros x m, apply h,
    apply lie_submodule.subset_lie_span, use [x, m], refl, },
end

lemma iterate_to_endomorphism_mem_lower_central_series (x : L) (m : M) (k : ℕ) :
  (to_endomorphism R L M x)^[k] m ∈ lower_central_series R L M k :=
begin
  induction k with k ih,
  { simp only [function.iterate_zero], },
  { simp only [lower_central_series_succ, function.comp_app, function.iterate_succ',
      to_endomorphism_apply_apply],
    exact lie_submodule.lie_mem_lie _ _ (lie_submodule.mem_top x) ih, },
end

variables {R L M}

lemma map_lower_central_series_le
  {M₂ : Type w₁} [add_comm_group M₂] [module R M₂] [lie_ring_module L M₂] [lie_module R L M₂]
  (k : ℕ) (f : M →ₗ⁅R,L⁆ M₂) :
  lie_submodule.map f (lower_central_series R L M k) ≤ lower_central_series R L M₂ k :=
begin
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero, le_top], },
  { simp only [lie_module.lower_central_series_succ, lie_submodule.map_bracket_eq],
    exact lie_submodule.mono_lie_right _ _ ⊤ ih, },
end

variables (R L M)
open lie_algebra

lemma derived_series_le_lower_central_series (k : ℕ) :
  derived_series R L k ≤ lower_central_series R L L k :=
begin
  induction k with k h,
  { rw [derived_series_def, derived_series_of_ideal_zero, lower_central_series_zero],
    exact le_rfl, },
  { have h' : derived_series R L k ≤ ⊤, { simp only [le_top], },
    rw [derived_series_def, derived_series_of_ideal_succ, lower_central_series_succ],
    exact lie_submodule.mono_lie _ _ _ _ h' h, },
end

/-- A Lie module is nilpotent if its lower central series reaches 0 (in a finite number of
steps). -/
class is_nilpotent : Prop :=
(nilpotent : ∃ k, lower_central_series R L M k = ⊥)

/-- See also `lie_module.is_nilpotent_iff_exists_ucs_eq_top`. -/
lemma is_nilpotent_iff :
  is_nilpotent R L M ↔ ∃ k, lower_central_series R L M k = ⊥ :=
⟨λ h, h.nilpotent, λ h, ⟨h⟩⟩

@[priority 100]
instance trivial_is_nilpotent [is_trivial L M] : is_nilpotent R L M :=
⟨by { use 1, change ⁅⊤, ⊤⁆ = ⊥, simp, }⟩

lemma nilpotent_endo_of_nilpotent_module [hM : is_nilpotent R L M] :
  ∃ (k : ℕ), ∀ (x : L), (to_endomorphism R L M x)^k = 0 :=
begin
  unfreezingI { obtain ⟨k, hM⟩ := hM, },
  use k,
  intros x, ext m,
  rw [linear_map.pow_apply, linear_map.zero_apply, ← @lie_submodule.mem_bot R L M, ← hM],
  exact iterate_to_endomorphism_mem_lower_central_series R L M x m k,
end

/-- For a nilpotent Lie module, the weight space of the 0 weight is the whole module.

This result will be used downstream to show that weight spaces are Lie submodules, at which time
it will be possible to state it in the language of weight spaces. -/
lemma infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L M] :
  (⨅ (x : L), (to_endomorphism R L M x).maximal_generalized_eigenspace 0) = ⊤ :=
begin
  ext m,
  simp only [module.End.mem_maximal_generalized_eigenspace, submodule.mem_top, sub_zero, iff_true,
    zero_smul, submodule.mem_infi],
  intros x,
  obtain ⟨k, hk⟩ := nilpotent_endo_of_nilpotent_module R L M,
  use k, rw hk,
  exact linear_map.zero_apply m,
end

/-- If the quotient of a Lie module `M` by a Lie submodule on which the Lie algebra acts trivially
is nilpotent then `M` is nilpotent.

This is essentially the Lie module equivalent of the fact that a central
extension of nilpotent Lie algebras is nilpotent. See `lie_algebra.nilpotent_of_nilpotent_quotient`
below for the corresponding result for Lie algebras. -/
lemma nilpotent_of_nilpotent_quotient {N : lie_submodule R L M}
  (h₁ : N ≤ max_triv_submodule R L M) (h₂ : is_nilpotent R L (M ⧸ N)) : is_nilpotent R L M :=
begin
  unfreezingI { obtain ⟨k, hk⟩ := h₂, },
  use k+1,
  simp only [lower_central_series_succ],
  suffices : lower_central_series R L M k ≤ N,
  { replace this := lie_submodule.mono_lie_right _ _ ⊤ (le_trans this h₁),
    rwa [ideal_oper_max_triv_submodule_eq_bot, le_bot_iff] at this, },
  rw [← lie_submodule.quotient.map_mk'_eq_bot_le, ← le_bot_iff, ← hk],
  exact map_lower_central_series_le k (lie_submodule.quotient.mk' N),
end

/-- Given a nilpotent Lie module `M` with lower central series `M = C₀ ≥ C₁ ≥ ⋯ ≥ Cₖ = ⊥`, this is
the natural number `k` (the number of inclusions).

For a non-nilpotent module, we use the junk value 0. -/
noncomputable def nilpotency_length : ℕ :=
Inf { k | lower_central_series R L M k = ⊥ }

lemma nilpotency_length_eq_zero_iff [is_nilpotent R L M] :
  nilpotency_length R L M = 0 ↔ subsingleton M :=
begin
  let s := { k | lower_central_series R L M k = ⊥ },
  have hs : s.nonempty,
  { unfreezingI { obtain ⟨k, hk⟩ := (by apply_instance : is_nilpotent R L M), },
    exact ⟨k, hk⟩, },
  change Inf s = 0 ↔ _,
  rw [← lie_submodule.subsingleton_iff R L M, ← subsingleton_iff_bot_eq_top,
      ← lower_central_series_zero, @eq_comm (lie_submodule R L M)],
  refine ⟨λ h, h ▸ nat.Inf_mem hs, λ h, _⟩,
  rw nat.Inf_eq_zero,
  exact or.inl h,
end

lemma nilpotency_length_eq_succ_iff (k : ℕ) :
  nilpotency_length R L M = k + 1 ↔
  lower_central_series R L M (k + 1) = ⊥ ∧ lower_central_series R L M k ≠ ⊥ :=
begin
  let s := { k | lower_central_series R L M k = ⊥ },
  change Inf s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s,
  have hs : ∀ k₁ k₂, k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s,
  { rintros k₁ k₂ h₁₂ (h₁ : lower_central_series R L M k₁ = ⊥),
    exact eq_bot_iff.mpr (h₁ ▸ antitone_lower_central_series R L M h₁₂), },
  exact nat.Inf_upward_closed_eq_succ_iff hs k,
end

/-- Given a non-trivial nilpotent Lie module `M` with lower central series
`M = C₀ ≥ C₁ ≥ ⋯ ≥ Cₖ = ⊥`, this is the `k-1`th term in the lower central series (the last
non-trivial term).

For a trivial or non-nilpotent module, this is the bottom submodule, `⊥`. -/
noncomputable def lower_central_series_last : lie_submodule R L M :=
match nilpotency_length R L M with
| 0     := ⊥
| k + 1 := lower_central_series R L M k
end

lemma lower_central_series_last_le_max_triv :
  lower_central_series_last R L M ≤ max_triv_submodule R L M :=
begin
  rw lower_central_series_last,
  cases h : nilpotency_length R L M with k,
  { exact bot_le, },
  { rw le_max_triv_iff_bracket_eq_bot,
    rw [nilpotency_length_eq_succ_iff, lower_central_series_succ] at h,
    exact h.1, },
end

lemma nontrivial_lower_central_series_last [nontrivial M] [is_nilpotent R L M] :
  nontrivial (lower_central_series_last R L M) :=
begin
  rw [lie_submodule.nontrivial_iff_ne_bot, lower_central_series_last],
  cases h : nilpotency_length R L M,
  { rw [nilpotency_length_eq_zero_iff, ← not_nontrivial_iff_subsingleton] at h,
    contradiction, },
  { rw nilpotency_length_eq_succ_iff at h,
    exact h.2, },
end

lemma nontrivial_max_triv_of_is_nilpotent [nontrivial M] [is_nilpotent R L M] :
  nontrivial (max_triv_submodule R L M) :=
set.nontrivial_mono
  (lower_central_series_last_le_max_triv R L M)
  (nontrivial_lower_central_series_last R L M)

@[simp] lemma coe_lcs_range_to_endomorphism_eq (k : ℕ) :
  (lower_central_series R (to_endomorphism R L M).range M k : submodule R M) =
  lower_central_series R L M k :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span',
      ← (lower_central_series R (to_endomorphism R L M).range M k).mem_coe_submodule, ih],
    congr,
    ext m,
    split,
    { rintros ⟨⟨-, ⟨y, rfl⟩⟩, -, n, hn, rfl⟩,
      exact ⟨y, lie_submodule.mem_top _, n, hn, rfl⟩, },
    { rintros ⟨x, hx, n, hn, rfl⟩,
      exact ⟨⟨to_endomorphism R L M x, lie_hom.mem_range_self _ x⟩, lie_submodule.mem_top _,
        n, hn, rfl⟩, }, },
end

@[simp] lemma is_nilpotent_range_to_endomorphism_iff :
  is_nilpotent R (to_endomorphism R L M).range M ↔ is_nilpotent R L M :=
begin
  split;
  rintros ⟨k, hk⟩;
  use k;
  rw ← lie_submodule.coe_to_submodule_eq_iff at ⊢ hk;
  simpa using hk,
end

end lie_module

namespace lie_submodule

variables {N₁ N₂ : lie_submodule R L M}

/-- The upper (aka ascending) central series.

See also `lie_submodule.lcs`. -/
def ucs (k : ℕ) : lie_submodule R L M → lie_submodule R L M :=
centralizer^[k]

@[simp] lemma ucs_zero : N.ucs 0 = N := rfl

@[simp] lemma ucs_succ (k : ℕ) :
  N.ucs (k + 1) = (N.ucs k).centralizer :=
function.iterate_succ_apply' centralizer k N

@[mono] lemma ucs_mono (k : ℕ) (h : N₁ ≤ N₂) :
  N₁.ucs k ≤ N₂.ucs k :=
begin
  induction k with k ih, { simpa, },
  simp only [ucs_succ],
  mono,
end

lemma ucs_eq_self_of_centralizer_eq_self (h : N₁.centralizer = N₁) (k : ℕ) :
  N₁.ucs k = N₁ :=
by { induction k with k ih, { simp, }, { rwa [ucs_succ, ih], }, }

/-- If a Lie module `M` contains a self-centralizing Lie submodule `N`, then all terms of the upper
central series of `M` are contained in `N`.

An important instance of this situation arises from a Cartan subalgebra `H ⊆ L` with the roles of
`L`, `M`, `N` played by `H`, `L`, `H`, respectively. -/
lemma ucs_le_of_centralizer_eq_self (h : N₁.centralizer = N₁) (k : ℕ) :
  (⊥ : lie_submodule R L M).ucs k ≤ N₁ :=
by { rw ← ucs_eq_self_of_centralizer_eq_self h k, mono, simp, }

lemma lcs_add_le_iff (l k : ℕ) :
  N₁.lcs (l + k) ≤ N₂ ↔ N₁.lcs l ≤ N₂.ucs k :=
begin
  revert l,
  induction k with k ih, { simp, },
  intros l,
  rw [(by abel : l + (k + 1) = l + 1 + k), ih, ucs_succ, lcs_succ, top_lie_le_iff_le_centralizer],
end

lemma lcs_le_iff (k : ℕ) :
  N₁.lcs k ≤ N₂ ↔ N₁ ≤ N₂.ucs k :=
by { convert lcs_add_le_iff 0 k, rw zero_add, }

lemma gc_lcs_ucs (k : ℕ):
  galois_connection (λ (N : lie_submodule R L M), N.lcs k) (λ (N : lie_submodule R L M), N.ucs k) :=
λ N₁ N₂, lcs_le_iff k

lemma ucs_eq_top_iff (k : ℕ) : N.ucs k = ⊤ ↔ lie_module.lower_central_series R L M k ≤ N :=
by { rw [eq_top_iff, ← lcs_le_iff], refl, }

lemma _root_.lie_module.is_nilpotent_iff_exists_ucs_eq_top :
  lie_module.is_nilpotent R L M ↔ ∃ k, (⊥ : lie_submodule R L M).ucs k = ⊤ :=
by { rw lie_module.is_nilpotent_iff, exact exists_congr (λ k, by simp [ucs_eq_top_iff]), }

lemma ucs_comap_incl (k : ℕ) :
  ((⊥ : lie_submodule R L M).ucs k).comap N.incl = (⊥ : lie_submodule R L N).ucs k :=
by { induction k with k ih, { exact N.ker_incl, }, { simp [← ih], }, }

lemma is_nilpotent_iff_exists_self_le_ucs :
  lie_module.is_nilpotent R L N ↔ ∃ k, N ≤ (⊥ : lie_submodule R L M).ucs k :=
by simp_rw [lie_module.is_nilpotent_iff_exists_ucs_eq_top, ← ucs_comap_incl, comap_incl_eq_top]

end lie_submodule

section morphisms

open lie_module function

variables {L₂ M₂ : Type*} [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 {f : L →ₗ⁅R⁆ L₂} {g : M →ₗ[R] M₂}
variables (hf : surjective f) (hg : surjective g) (hfg : ∀ x m, ⁅f x, g m⁆ = g ⁅x, m⁆)

include hf hg hfg

lemma function.surjective.lie_module_lcs_map_eq (k : ℕ) :
  (lower_central_series R L M k : submodule R M).map g = lower_central_series R L₂ M₂ k :=
begin
  induction k with k ih,
  { simp [linear_map.range_eq_top, hg], },
  { suffices : g '' {m | ∃ (x : L) n, n ∈ lower_central_series R L M k ∧ ⁅x, n⁆ = m} =
               {m | ∃ (x : L₂) n, n ∈ lower_central_series R L M k ∧ ⁅x, g n⁆ = m},
    { simp only [← lie_submodule.mem_coe_submodule] at this,
      simp [← lie_submodule.mem_coe_submodule, ← ih, lie_submodule.lie_ideal_oper_eq_linear_span',
        submodule.map_span, -submodule.span_image, this], },
    ext m₂,
    split,
    { rintros ⟨m, ⟨x, n, hn, rfl⟩, rfl⟩,
      exact ⟨f x, n, hn, hfg x n⟩, },
    { rintros ⟨x, n, hn, rfl⟩,
      obtain ⟨y, rfl⟩ := hf x,
      exact ⟨⁅y, n⁆, ⟨y, n, hn, rfl⟩, (hfg y n).symm⟩, }, },
end

lemma function.surjective.lie_module_is_nilpotent [is_nilpotent R L M] : is_nilpotent R L₂ M₂ :=
begin
  obtain ⟨k, hk⟩ := id (by apply_instance : is_nilpotent R L M),
  use k,
  rw ← lie_submodule.coe_to_submodule_eq_iff at ⊢ hk,
  simp [← hf.lie_module_lcs_map_eq hg hfg k, hk],
end

omit hf hg hfg

lemma equiv.lie_module_is_nilpotent_iff (f : L ≃ₗ⁅R⁆ L₂) (g : M ≃ₗ[R] M₂)
  (hfg : ∀ x m, ⁅f x, g m⁆ = g ⁅x, m⁆) :
  is_nilpotent R L M ↔ is_nilpotent R L₂ M₂ :=
begin
  split;
  introsI h,
  { have hg : surjective (g : M →ₗ[R] M₂) := g.surjective,
    exact f.surjective.lie_module_is_nilpotent hg hfg, },
  { have hg : surjective (g.symm : M₂ →ₗ[R] M) := g.symm.surjective,
    refine f.symm.surjective.lie_module_is_nilpotent hg (λ x m, _),
    rw [linear_equiv.coe_coe, lie_equiv.coe_to_lie_hom, ← g.symm_apply_apply ⁅f.symm x, g.symm m⁆,
      ← hfg, f.apply_symm_apply, g.apply_symm_apply], },
end

@[simp] lemma lie_module.is_nilpotent_of_top_iff :
  is_nilpotent R (⊤ : lie_subalgebra R L) M ↔ is_nilpotent R L M :=
equiv.lie_module_is_nilpotent_iff lie_subalgebra.top_equiv (1 : M ≃ₗ[R] M) (λ x m, rfl)

end morphisms

end nilpotent_modules

@[priority 100]
instance lie_algebra.is_solvable_of_is_nilpotent (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [hL : lie_module.is_nilpotent R L L] :
  lie_algebra.is_solvable R L :=
begin
  obtain ⟨k, h⟩ : ∃ k, lie_module.lower_central_series R L L k = ⊥ := hL.nilpotent,
  use k, rw ← le_bot_iff at h ⊢,
  exact le_trans (lie_module.derived_series_le_lower_central_series R L k) h,
end

section nilpotent_algebras

variables (R : Type u) (L : Type v) (L' : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']

/-- We say a Lie algebra is nilpotent when it is nilpotent as a Lie module over itself via the
adjoint representation. -/
abbreviation lie_algebra.is_nilpotent (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] : Prop :=
lie_module.is_nilpotent R L L

open lie_algebra

lemma lie_algebra.nilpotent_ad_of_nilpotent_algebra [is_nilpotent R L] :
  ∃ (k : ℕ), ∀ (x : L), (ad R L x)^k = 0 :=
lie_module.nilpotent_endo_of_nilpotent_module R L L

/-- See also `lie_algebra.zero_root_space_eq_top_of_nilpotent`. -/
lemma lie_algebra.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L] :
  (⨅ (x : L), (ad R L x).maximal_generalized_eigenspace 0) = ⊤ :=
lie_module.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent R L L

-- TODO Generalise the below to Lie modules if / when we define morphisms, equivs of Lie modules
-- covering a Lie algebra morphism of (possibly different) Lie algebras.

variables {R L L'}

open lie_module (lower_central_series)

/-- Given an ideal `I` of a Lie algebra `L`, the lower central series of `L ⧸ I` is the same
whether we regard `L ⧸ I` as an `L` module or an `L ⧸ I` module.

TODO: This result obviously generalises but the generalisation requires the missing definition of
morphisms between Lie modules over different Lie algebras. -/
lemma coe_lower_central_series_ideal_quot_eq {I : lie_ideal R L} (k : ℕ) :
  (lower_central_series R L (L ⧸ I) k : submodule R (L ⧸ I)) =
  lower_central_series R (L ⧸ I) (L ⧸ I) k :=
begin
  induction k with k ih,
  { simp only [lie_submodule.top_coe_submodule, lie_module.lower_central_series_zero], },
  { simp only [lie_module.lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span],
    congr,
    ext x,
    split,
    { rintros ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩,
      erw [← lie_submodule.mem_coe_submodule, ih, lie_submodule.mem_coe_submodule] at hz,
      exact ⟨⟨lie_submodule.quotient.mk y, submodule.mem_top⟩, ⟨z, hz⟩, rfl⟩, },
    { rintros ⟨⟨⟨y⟩, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩,
      erw [← lie_submodule.mem_coe_submodule, ← ih, lie_submodule.mem_coe_submodule] at hz,
      exact ⟨⟨y, submodule.mem_top⟩, ⟨z, hz⟩, rfl⟩, }, },
end

/-- Note that the below inequality can be strict. For example the ideal of strictly-upper-triangular
2x2 matrices inside the Lie algebra of upper-triangular 2x2 matrices with `k = 1`. -/
lemma lie_module.coe_lower_central_series_ideal_le {I : lie_ideal R L} (k : ℕ) :
  (lower_central_series R I I k : submodule R I) ≤ lower_central_series R L I k :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lie_module.lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span],
    apply submodule.span_mono,
    rintros x ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩,
    exact ⟨⟨y.val, submodule.mem_top⟩, ⟨z, ih hz⟩, rfl⟩, },
end

/-- A central extension of nilpotent Lie algebras is nilpotent. -/
lemma lie_algebra.nilpotent_of_nilpotent_quotient {I : lie_ideal R L}
  (h₁ : I ≤ center R L) (h₂ : is_nilpotent R (L ⧸ I)) : is_nilpotent R L :=
begin
  suffices : lie_module.is_nilpotent R L (L ⧸ I),
  { exact lie_module.nilpotent_of_nilpotent_quotient R L L h₁ this, },
  unfreezingI { obtain ⟨k, hk⟩ := h₂, },
  use k,
  simp [← lie_submodule.coe_to_submodule_eq_iff, coe_lower_central_series_ideal_quot_eq, hk],
end

lemma lie_algebra.non_trivial_center_of_is_nilpotent [nontrivial L] [is_nilpotent R L] :
  nontrivial $ center R L :=
lie_module.nontrivial_max_triv_of_is_nilpotent R L L

lemma lie_ideal.map_lower_central_series_le (k : ℕ) {f : L →ₗ⁅R⁆ L'} :
  lie_ideal.map f (lower_central_series R L L k) ≤ lower_central_series R L' L' k :=
begin
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero, le_top], },
  { simp only [lie_module.lower_central_series_succ],
    exact le_trans (lie_ideal.map_bracket_le f) (lie_submodule.mono_lie _ _ _ _ le_top ih), },
end

lemma lie_ideal.lower_central_series_map_eq (k : ℕ) {f : L →ₗ⁅R⁆ L'}
  (h : function.surjective f) :
  lie_ideal.map f (lower_central_series R L L k) = lower_central_series R L' L' k :=
begin
  have h' : (⊤ : lie_ideal R L).map f = ⊤,
  { rw ←f.ideal_range_eq_map,
    exact f.ideal_range_eq_top_of_surjective h, },
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero], exact h', },
  { simp only [lie_module.lower_central_series_succ, lie_ideal.map_bracket_eq f h, ih, h'], },
end

lemma function.injective.lie_algebra_is_nilpotent [h₁ : is_nilpotent R L'] {f : L →ₗ⁅R⁆ L'}
  (h₂ : function.injective f) : is_nilpotent R L :=
{ nilpotent :=
  begin
    obtain ⟨k, hk⟩ := id h₁,
    use k,
    apply lie_ideal.bot_of_map_eq_bot h₂, rw [eq_bot_iff, ← hk],
    apply lie_ideal.map_lower_central_series_le,
  end, }

lemma function.surjective.lie_algebra_is_nilpotent [h₁ : is_nilpotent R L] {f : L →ₗ⁅R⁆ L'}
  (h₂ : function.surjective f) : is_nilpotent R L' :=
{ nilpotent :=
  begin
    obtain ⟨k, hk⟩ := id h₁,
    use k,
    rw [← lie_ideal.lower_central_series_map_eq k h₂, hk],
    simp only [lie_ideal.map_eq_bot_iff, bot_le],
  end, }

lemma lie_equiv.nilpotent_iff_equiv_nilpotent (e : L ≃ₗ⁅R⁆ L') :
  is_nilpotent R L ↔ is_nilpotent R L' :=
begin
  split; introsI h,
  { exact e.symm.injective.lie_algebra_is_nilpotent, },
  { exact e.injective.lie_algebra_is_nilpotent, },
end

lemma lie_hom.is_nilpotent_range [is_nilpotent R L] (f : L →ₗ⁅R⁆ L') :
  is_nilpotent R f.range :=
f.surjective_range_restrict.lie_algebra_is_nilpotent

/-- Note that this result is not quite a special case of
`lie_module.is_nilpotent_range_to_endomorphism_iff` which concerns nilpotency of the
`(ad R L).range`-module `L`, whereas this result concerns nilpotency of the `(ad R L).range`-module
`(ad R L).range`. -/
@[simp] lemma lie_algebra.is_nilpotent_range_ad_iff :
  is_nilpotent R (ad R L).range ↔ is_nilpotent R L :=
begin
  refine ⟨λ h, _, _⟩,
  { have : (ad R L).ker = center R L, { simp, },
    exact lie_algebra.nilpotent_of_nilpotent_quotient (le_of_eq this)
      ((ad R L).quot_ker_equiv_range.nilpotent_iff_equiv_nilpotent.mpr h), },
  { introsI h,
    exact (ad R L).is_nilpotent_range, },
end

instance [h : lie_algebra.is_nilpotent R L] : lie_algebra.is_nilpotent R (⊤ : lie_subalgebra R L) :=
lie_subalgebra.top_equiv.nilpotent_iff_equiv_nilpotent.mpr h

end nilpotent_algebras

namespace lie_ideal

open lie_module

variables {R L : Type*} [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L)
variables (M : Type*) [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables (k : ℕ)

/-- Given a Lie module `M` over a Lie algebra `L` together with an ideal `I` of `L`, this is the
lower central series of `M` as an `I`-module. The advantage of using this definition instead of
`lie_module.lower_central_series R I M` is that its terms are Lie submodules of `M` as an
`L`-module, rather than just as an `I`-module.

See also `lie_ideal.coe_lcs_eq`. -/
def lcs : lie_submodule R L M := (λ N, ⁅I, N⁆)^[k] ⊤

@[simp] lemma lcs_zero : I.lcs M 0 = ⊤ := rfl

@[simp] lemma lcs_succ : I.lcs M (k + 1) = ⁅I, I.lcs M k⁆ :=
function.iterate_succ_apply' (λ N, ⁅I, N⁆) k ⊤

lemma lcs_top : (⊤ : lie_ideal R L).lcs M k = lower_central_series R L M k := rfl

lemma coe_lcs_eq : (I.lcs M k : submodule R M) = lower_central_series R I M k :=
begin
  induction k with k ih,
  { simp, },
  { simp_rw [lower_central_series_succ, lcs_succ, lie_submodule.lie_ideal_oper_eq_linear_span',
      ← (I.lcs M k).mem_coe_submodule, ih, lie_submodule.mem_coe_submodule,
      lie_submodule.mem_top, exists_true_left, lie_subalgebra.coe_bracket_of_module],
    congr,
    ext m,
    split,
    { rintros ⟨x, hx, m, hm, rfl⟩,
      exact ⟨⟨x, hx⟩, m, hm, rfl⟩, },
    { rintros ⟨⟨x, hx⟩, m, hm, rfl⟩,
      exact ⟨x, hx, m, hm, rfl⟩, }, },
end

end lie_ideal

section of_associative

variables (R : Type u) {A : Type v} [comm_ring R] [ring A] [algebra R A]

lemma lie_algebra.ad_nilpotent_of_nilpotent {a : A} (h : is_nilpotent a) :
  is_nilpotent (lie_algebra.ad R A a) :=
begin
  rw lie_algebra.ad_eq_lmul_left_sub_lmul_right,
  have hl : is_nilpotent (algebra.lmul_left R a), { rwa algebra.is_nilpotent_lmul_left_iff, },
  have hr : is_nilpotent (algebra.lmul_right R a), { rwa algebra.is_nilpotent_lmul_right_iff, },
  exact (algebra.commute_lmul_left_right R a a).is_nilpotent_sub hl hr,
end

variables {R}

lemma lie_subalgebra.is_nilpotent_ad_of_is_nilpotent_ad {L : Type v} [lie_ring L] [lie_algebra R L]
  (K : lie_subalgebra R L) {x : K} (h : is_nilpotent (lie_algebra.ad R L ↑x)) :
  is_nilpotent (lie_algebra.ad R K x) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  exact linear_map.submodule_pow_eq_zero_of_pow_eq_zero (K.ad_comp_incl_eq x) hn,
end

lemma lie_algebra.is_nilpotent_ad_of_is_nilpotent {L : lie_subalgebra R A} {x : L}
  (h : is_nilpotent (x : A)) : is_nilpotent (lie_algebra.ad R L x) :=
L.is_nilpotent_ad_of_is_nilpotent_ad $ lie_algebra.ad_nilpotent_of_nilpotent R h

end of_associative


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.ordered_group order.lattice

open lattice

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

attribute [simp] max_eq_left max_eq_right min_eq_left min_eq_right

section
variables [decidable_linear_order α] [decidable_linear_order β] {f : α → β} {a b c d : α}

-- translate from lattices to linear orders (sup → max, inf → min)
lemma le_min_iff : c ≤ min a b ↔ c ≤ a ∧ c ≤ b := le_inf_iff
lemma max_le_iff : max a b ≤ c ↔ a ≤ c ∧ b ≤ c := sup_le_iff
lemma max_le_max : a ≤ c → b ≤ d → max a b ≤ max c d := sup_le_sup
lemma min_le_min : a ≤ c → b ≤ d → min a b ≤ min c d := inf_le_inf
lemma le_max_left_of_le : a ≤ b → a ≤ max b c := le_sup_left_of_le
lemma le_max_right_of_le : a ≤ c → a ≤ max b c := le_sup_right_of_le
lemma min_le_left_of_le : a ≤ c → min a b ≤ c := inf_le_left_of_le
lemma min_le_right_of_le : b ≤ c → min a b ≤ c := inf_le_right_of_le
lemma max_min_distrib_left : max a (min b c) = min (max a b) (max a c) := sup_inf_left
lemma max_min_distrib_right : max (min a b) c = min (max a c) (max b c) := sup_inf_right
lemma min_max_distrib_left : min a (max b c) = max (min a b) (min a c) := inf_sup_left
lemma min_max_distrib_right : min (max a b) c = max (min a c) (min b c) := inf_sup_right

instance max_idem : is_idempotent α max := by apply_instance
instance min_idem : is_idempotent α min := by apply_instance

lemma min_le_iff : min a b ≤ c ↔ a ≤ c ∨ b ≤ c :=
have a ≤ b → (a ≤ c ∨ b ≤ c ↔ a ≤ c),
  from assume h, or_iff_left_of_imp $ le_trans h,
have b ≤ a → (a ≤ c ∨ b ≤ c ↔ b ≤ c),
  from assume h, or_iff_right_of_imp $ le_trans h,
by cases le_total a b; simp *

lemma le_max_iff : a ≤ max b c ↔ a ≤ b ∨ a ≤ c :=
have b ≤ c → (a ≤ b ∨ a ≤ c ↔ a ≤ c),
  from assume h, or_iff_right_of_imp $ assume h', le_trans h' h,
have c ≤ b → (a ≤ b ∨ a ≤ c ↔ a ≤ b),
  from assume h, or_iff_left_of_imp $ assume h', le_trans h' h,
by cases le_total b c; simp *

lemma max_lt_iff : max a b < c ↔ (a < c ∧ b < c) :=
by rw [lt_iff_not_ge]; simp [(≥), le_max_iff, not_or_distrib]

lemma lt_min_iff : a < min b c ↔ (a < b ∧ a < c) :=
by rw [lt_iff_not_ge]; simp [(≥), min_le_iff, not_or_distrib]

lemma lt_max_iff : a < max b c ↔ a < b ∨ a < c :=
by rw [lt_iff_not_ge]; simp [(≥), max_le_iff, not_and_distrib]

lemma min_lt_iff : min a b < c ↔ a < c ∨ b < c :=
by rw [lt_iff_not_ge]; simp [(≥), le_min_iff, not_and_distrib]

theorem min_right_comm (a b c : α) : min (min a b) c = min (min a c) b :=
right_comm min min_comm min_assoc a b c

theorem max.left_comm (a b c : α) : max a (max b c) = max b (max a c) :=
left_comm max max_comm max_assoc a b c

theorem max.right_comm (a b c : α) : max (max a b) c = max (max a c) b :=
right_comm max max_comm max_assoc a b c

lemma max_distrib_of_monotone (hf : monotone f) : f (max a b) = max (f a) (f b) :=
by cases le_total a b; simp [h, hf h]

lemma min_distrib_of_monotone (hf : monotone f) : f (min a b) = min (f a) (f b) :=
by cases le_total a b; simp [h, hf h]

theorem min_choice (a b : α) : min a b = a ∨ min a b = b :=
by by_cases h : a ≤ b; simp [min, h]

theorem max_choice (a b : α) : max a b = a ∨ max a b = b :=
by by_cases h : a ≤ b; simp [max, h]

lemma le_of_max_le_left {a b c : α} (h : max a b ≤ c) : a ≤ c :=
le_trans (le_max_left _ _) h

lemma le_of_max_le_right {a b c : α} (h : max a b ≤ c) : b ≤ c :=
le_trans (le_max_right _ _) h

end

lemma min_add {α : Type u} [decidable_linear_ordered_comm_group α] (a b c : α) :
      min a b + c = min (a + c) (b + c) :=
if hle : a ≤ b then
  have a - c ≤ b - c, from sub_le_sub hle (le_refl _),
  by simp * at *
else
  have b - c ≤ a - c, from sub_le_sub (le_of_lt (lt_of_not_ge hle)) (le_refl _),
  by simp * at *

lemma min_sub {α : Type u} [decidable_linear_ordered_comm_group α] (a b c : α) :
      min a b - c = min (a - c) (b - c) :=
by simp [min_add, sub_eq_add_neg]

section decidable_linear_ordered_comm_group
variables [decidable_linear_ordered_comm_group α] {a b c : α}

attribute [simp] abs_zero abs_neg

def abs_add := @abs_add_le_abs_add_abs

theorem abs_le : abs a ≤ b ↔ - b ≤ a ∧ a ≤ b :=
⟨assume h, ⟨neg_le_of_neg_le $ le_trans (neg_le_abs_self _) h, le_trans (le_abs_self _) h⟩,
  assume ⟨h₁, h₂⟩, abs_le_of_le_of_neg_le h₂ $ neg_le_of_neg_le h₁⟩

lemma abs_lt : abs a < b ↔ - b < a ∧ a < b :=
⟨assume h, ⟨neg_lt_of_neg_lt $ lt_of_le_of_lt (neg_le_abs_self _) h, lt_of_le_of_lt (le_abs_self _) h⟩,
  assume ⟨h₁, h₂⟩, abs_lt_of_lt_of_neg_lt h₂ $ neg_lt_of_neg_lt h₁⟩

lemma abs_sub_le_iff : abs (a - b) ≤ c ↔ a - b ≤ c ∧ b - a ≤ c :=
by rw [abs_le, neg_le_sub_iff_le_add, @sub_le_iff_le_add' _ _ b, and_comm]

lemma abs_sub_lt_iff : abs (a - b) < c ↔ a - b < c ∧ b - a < c :=
by rw [abs_lt, neg_lt_sub_iff_lt_add, @sub_lt_iff_lt_add' _ _ b, and_comm]

def sub_abs_le_abs_sub := @abs_sub_abs_le_abs_sub

lemma abs_abs_sub_le_abs_sub (a b : α) : abs (abs a - abs b) ≤ abs (a - b) :=
abs_sub_le_iff.2 ⟨sub_abs_le_abs_sub _ _, by rw abs_sub; apply sub_abs_le_abs_sub⟩

lemma abs_eq (hb : b ≥ 0) : abs a = b ↔ a = b ∨ a = -b :=
iff.intro
  begin
    cases le_total a 0 with a_nonpos a_nonneg,
    { rw [abs_of_nonpos a_nonpos, neg_eq_iff_neg_eq, eq_comm], exact or.inr },
    { rw [abs_of_nonneg a_nonneg, eq_comm], exact or.inl }
  end
  (by intro h; cases h; subst h; try { rw abs_neg }; exact abs_of_nonneg hb)

@[simp] lemma abs_eq_zero : abs a = 0 ↔ a = 0 :=
⟨eq_zero_of_abs_eq_zero, λ e, e.symm ▸ abs_zero⟩

lemma abs_pos_iff {a : α} : 0 < abs a ↔ a ≠ 0 :=
⟨λ h, mt abs_eq_zero.2 (ne_of_gt h), abs_pos_of_ne_zero⟩

lemma abs_le_max_abs_abs (hab : a ≤ b)  (hbc : b ≤ c) : abs b ≤ max (abs a) (abs c) :=
abs_le_of_le_of_neg_le
  (by simp [le_max_iff, le_trans hbc (le_abs_self c)])
  (by simp [le_max_iff, le_trans (neg_le_neg hab) (neg_le_abs_self a)])

lemma min_le_add_of_nonneg_right {a b : α} (hb : b ≥ 0) : min a b ≤ a + b :=
calc
  min a b ≤ a     : by apply min_le_left
      ... ≤ a + b : le_add_of_nonneg_right hb

lemma min_le_add_of_nonneg_left {a b : α} (ha : a ≥ 0) : min a b ≤ a + b :=
calc
  min a b ≤ b     : by apply min_le_right
      ... ≤ a + b : le_add_of_nonneg_left ha

lemma max_le_add_of_nonneg {a b : α} (ha : a ≥ 0) (hb : b ≥ 0) : max a b ≤ a + b :=
max_le_iff.2 (by split; simpa)

end decidable_linear_ordered_comm_group

section decidable_linear_ordered_comm_ring
variables [decidable_linear_ordered_comm_ring α] {a b c d : α}

@[simp] lemma abs_one : abs (1 : α) = 1 := abs_of_pos zero_lt_one

lemma monotone_mul_of_nonneg (ha : 0 ≤ a) : monotone (λ x, a*x) :=
assume b c b_le_c, mul_le_mul_of_nonneg_left b_le_c ha

lemma mul_max_of_nonneg (b c : α) (ha : 0 ≤ a) : a * max b c = max (a * b) (a * c) :=
max_distrib_of_monotone (monotone_mul_of_nonneg ha)

lemma mul_min_of_nonneg (b c : α) (ha : 0 ≤ a) : a * min b c = min (a * b) (a * c) :=
min_distrib_of_monotone (monotone_mul_of_nonneg ha)

lemma max_mul_mul_le_max_mul_max (b c : α) (ha : 0 ≤ a) (hd: 0 ≤ d) :
  max (a * b) (d * c) ≤ max a c * max d b :=
have ba : b * a ≤ max d b * max c a,
  from mul_le_mul (le_max_right d b) (le_max_right c a) ha (le_trans hd (le_max_left d b)),
have cd : c * d ≤ max a c * max b d,
  from mul_le_mul (le_max_right a c) (le_max_right b d) hd (le_trans ha (le_max_left a c)),
max_le
  (by simpa [mul_comm, max_comm] using ba)
  (by simpa [mul_comm, max_comm] using cd)

end decidable_linear_ordered_comm_ring


import number_theory.pell

-- Solutions to Pell’s Equation

open pell

theorem t039 {a x y : ℕ} : Π (a1 : a > 1), (x*x - (a * a - 1) * y * y = 1) → ∃n, x = xn a1 n ∧ y = yn a1 n
:= begin
  intros,
  refine eq_pell _ _,
  rw ← a_1,
  ring,
end


import SciLean.Core
import SciLean.Data.GenericArray

set_option synthInstance.maxSize 2048

def Fin.shift {n} (y : Int) (x : Fin n) : Fin n := ⟨(((x.1 + y) % n + n) % n).toNat, sorry_proof⟩

instance Fin.shift.arg_x.isInv (y : Int) : SciLean.IsInv (λ x : Fin n => x.shift y) := sorry_proof
@[simp]
theorem Fin.shift.arg_x.inv_simp {n} [Nonempty (Fin n)] (y : Int)
  : (λ x : Fin n => x.shift y)⁻¹ = (λ x : Fin n => x.shift (-y)) := by sorry_proof

def Fin.scale {n} (x : Fin n) (y : Nat) : Fin (y*n) := ⟨x.1*y, sorry_proof⟩
def Fin.scaleUp {N n : Nat} (x : Fin (N/n)) : Fin N := ⟨x.1*n, sorry_proof⟩

namespace SciLean

  instance {n} [Fact (n≠0)] : Nonempty (Fin n) := sorry_proof

  def conv1d {N n} (x : Fin N → ℝ) (w : Fin n → ℝ) (b : ℝ) : Fin N → ℝ :=
     λ i => ∑ i', w i' * x (i.shift i') + b
  argument x [Fact (N≠0)] [Fact (n≠0)]
    isSmooth,
    hasAdjDiff,
    adjDiff by
      simp only [adjointDifferential, conv1d]
      simp[hold, sum_into_lambda]
      enter[x]
      rw [sum_swap]
      simp only [kron_smul_assoc, sum_of_kron_2]
      simp
  argument w [Fact (N≠0)] [Fact (n≠0)]
    isSmooth,
    hasAdjDiff,
    adjDiff by
      simp only [adjointDifferential, conv1d]
      simp[hold, sum_into_lambda]
      simp only [kron_smul_assoc, sum_of_kron_2]
      simp
  argument b [Fact (N≠0)] [Fact (n≠0)]
    isSmooth,
    hasAdjDiff,
    adjDiff by
      simp only [adjointDifferential]
      unfold conv1d; simp

  def conv2d {N M n m} (x : Fin N → Fin M → ℝ) (w : Fin n → Fin m → ℝ) (b : ℝ) : Fin N → Fin M → ℝ :=
     λ i j => ∑ i' j', w i' j' * x (i.shift i') (j.shift j') + b
  argument x [Fact (N≠0)] [Fact (M≠0)]
    isSmooth,
    hasAdjDiff,
    adjDiff by
      simp only [adjointDifferential, conv2d]
      simp[sum_into_lambda]
      enter[i,j]
      conv =>
        rw [sum_swap]; enter[1]; ext
        rw [sum_swap]; enter[1]; ext
        rw [sum_swap]; enter[1]; ext
        simp only [kron_smul_assoc, sum_of_kron_2]
        simp
      conv =>
        rw [sum_swap]; enter[1]; ext
        rw [sum_swap]; enter[1]; ext
        simp only [kron_smul_assoc, sum_of_kron_2]
        simp
      simp
  argument w [Fact (n≠0)] [Fact (m≠0)]
    isSmooth,
    hasAdjDiff,
    adjDiff by
      simp only [adjointDifferential, conv2d]
      simp[hold, sum_into_lambda]
      enter [i',j']
      conv =>
        enter [1]; ext; enter [1]; ext
        rw[sum_swap]
        simp only [kron_smul_assoc, sum_of_kron_2]
        simp
        simp only [kron_smul_assoc, sum_of_kron_2]
      simp
  argument b [Fact (N≠0)] [Fact (n≠0)]
    isSmooth,
    hasAdjDiff,
    adjDiff by
      simp only [adjointDifferential,conv2d]
      simp

  -- argument w [Fact (N≠0)] [Fact (n≠0)]
  --   hasAdjDiff,
  --   adjDiff by
  --     simp only [adjointDifferential, conv1d]
  --     simp[hold, sum_into_lambda]
  --     simp only [kron_smul_assoc, sum_of_kron_2]
  --     simp
  -- argument b [Fact (N≠0)] [Fact (n≠0)]
  --   hasAdjDiff,
  --   adjDiff by
  --     simp only [adjointDifferential]
  --     unfold conv1d; simp


--                            |   Premisa  |
lemma Example_1 (A B : Prop) : A ∧ (A → B) → B :=
begin
    -- Complete
end
--                                |         Premisas          |
lemma Example_2 (A B C D : Prop) : (A ∨ B) → (A → C) → (B → D) → C ∨ D :=
begin
    -- Complete
end
--                            |  Premisa |
lemma Example_3 (A B : Prop) : ¬ (A ∧ B) → (A → ¬ B) :=
begin
    -- Complete
end


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

import category_theory.monoidal.category

/-!
# Rigid (autonomous) monoidal categories

This file defines rigid (autonomous) monoidal categories and the necessary theory about
exact pairings and duals.

## Main definitions

* `exact_pairing` of two objects of a monoidal category
* Type classes `has_left_dual` and `has_right_dual` that capture that a pairing exists
* The `right_adjoint_mate f` as a morphism `fᘁ : Yᘁ ⟶ Xᘁ` for a morphism `f : X ⟶ Y`
* The classes of `right_rigid_category`, `left_rigid_category` and `rigid_category`

## Main statements

* `comp_right_adjoint_mate`: The adjoint mates of the composition is the composition of
  adjoint mates.

## Notations

* `η_` and `ε_` denote the coevaluation and evaluation morphism of an exact pairing.
* `Xᘁ` and `ᘁX` denote the right and left dual of an object, as well as the adjoint
  mate of a morphism.

## Future work

* Show that `X ⊗ Y` and `Yᘁ ⊗ Xᘁ` form an exact pairing.
* Show that the left adjoint mate of the right adjoint mate of a morphism is the morphism itself.
* Simplify constructions in the case where a symmetry or braiding is present.
* Connect this definition to `monoidal_closed`: an object with a (left?) dual is
  a closed object `X` such that the right adjoint of `X ⊗ -` is given by `Y ⊗ -` for some `Y`.
* Show that `ᘁ` gives an equivalence of categories `C ≅ (Cᵒᵖ)ᴹᵒᵖ`.
* Define pivotal categories (rigid categories equipped with a natural isomorphism `ᘁᘁ ≅ 𝟙 C`).

## References

* <https://ncatlab.org/nlab/show/rigid+monoidal+category>

## Tags

rigid category, monoidal category

-/
open category_theory

universes v v₁ v₂ v₃ u u₁ u₂ u₃
noncomputable theory

namespace category_theory

variables {C : Type u₁} [category.{v₁} C] [monoidal_category C]

/-- An exact pairing is a pair of objects `X Y : C` which admit
  a coevaluation and evaluation morphism which fulfill two triangle equalities. -/
class exact_pairing (X Y : C) :=
(coevaluation [] : 𝟙_ C ⟶ X ⊗ Y)
(evaluation [] : Y ⊗ X ⟶ 𝟙_ C)
(coevaluation_evaluation' [] :
  (𝟙 Y ⊗ coevaluation) ≫ (α_ _ _ _).inv ≫ (evaluation ⊗ 𝟙 Y)
  = (ρ_ Y).hom ≫ (λ_ Y).inv . obviously)
(evaluation_coevaluation' [] :
  (coevaluation ⊗ 𝟙 X) ≫ (α_ _ _ _).hom ≫ (𝟙 X ⊗ evaluation)
  = (λ_ X).hom ≫ (ρ_ X).inv . obviously)

open exact_pairing

notation `η_` := exact_pairing.coevaluation
notation `ε_` := exact_pairing.evaluation

restate_axiom coevaluation_evaluation'
attribute [reassoc, simp] exact_pairing.coevaluation_evaluation
restate_axiom evaluation_coevaluation'
attribute [reassoc, simp] exact_pairing.evaluation_coevaluation

instance exact_pairing_unit : exact_pairing (𝟙_ C) (𝟙_ C) :=
{ coevaluation := (ρ_ _).inv,
  evaluation := (ρ_ _).hom,
  coevaluation_evaluation' := by
  { rw[monoidal_category.triangle_assoc_comp_right,
      monoidal_category.unitors_inv_equal,
      monoidal_category.unitors_equal], simp },
  evaluation_coevaluation' := by
  { rw[monoidal_category.triangle_assoc_comp_right_inv_assoc,
      monoidal_category.unitors_inv_equal,
      monoidal_category.unitors_equal], simp } }

/-- A class of objects which have a right dual. -/
class has_right_dual (X : C) :=
(right_dual : C)
[exact : exact_pairing X right_dual]

/-- A class of objects with have a left dual. -/
class has_left_dual (Y : C) :=
(left_dual : C)
[exact : exact_pairing left_dual Y]

attribute [instance] has_right_dual.exact
attribute [instance] has_left_dual.exact

open exact_pairing has_right_dual has_left_dual monoidal_category

prefix `ᘁ`:1025 := left_dual
postfix `ᘁ`:1025 := right_dual

instance has_right_dual_unit : has_right_dual (𝟙_ C) :=
{ right_dual := 𝟙_ C }

instance has_left_dual_unit : has_left_dual (𝟙_ C) :=
{ left_dual := 𝟙_ C }

instance has_right_dual_left_dual {X : C} [has_left_dual X] : has_right_dual (ᘁX) :=
{ right_dual := X }

instance has_left_dual_right_dual {X : C} [has_right_dual X] : has_left_dual Xᘁ :=
{ left_dual := X }

@[simp]
lemma left_dual_right_dual {X : C} [has_right_dual X] : ᘁ(Xᘁ) = X := rfl

@[simp]
lemma right_dual_left_dual {X : C} [has_left_dual X] : (ᘁX)ᘁ = X := rfl

/-- The right adjoint mate `fᘁ : Xᘁ ⟶ Yᘁ` of a morphism `f : X ⟶ Y`. -/
def right_adjoint_mate {X Y : C} [has_right_dual X] [has_right_dual Y] (f : X ⟶ Y) : Yᘁ ⟶ Xᘁ :=
(ρ_ _).inv ≫ (𝟙 _ ⊗ η_ _ _) ≫ (𝟙 _ ⊗ (f ⊗ 𝟙 _))
 ≫ (α_ _ _ _).inv ≫ ((ε_ _ _) ⊗ 𝟙 _) ≫ (λ_ _).hom

/-- The left adjoint mate `ᘁf : ᘁY ⟶ ᘁX` of a morphism `f : X ⟶ Y`. -/
def left_adjoint_mate {X Y : C} [has_left_dual X] [has_left_dual Y] (f : X ⟶ Y) : ᘁY ⟶ ᘁX :=
(λ_ _).inv ≫ (η_ (ᘁX) X ⊗ 𝟙 _) ≫ ((𝟙 _ ⊗ f) ⊗ 𝟙 _)
 ≫ (α_ _ _ _).hom ≫ (𝟙 _ ⊗ ε_ _ _) ≫ (ρ_ _).hom

notation f `ᘁ` := right_adjoint_mate f
notation `ᘁ` f := left_adjoint_mate f

@[simp]
lemma right_adjoint_mate_id {X : C} [has_right_dual X] : (𝟙 X)ᘁ = 𝟙 (Xᘁ) :=
by simp only [right_adjoint_mate, monoidal_category.tensor_id, category.id_comp,
  coevaluation_evaluation_assoc, category.comp_id, iso.inv_hom_id]

@[simp]
lemma left_adjoint_mate_id {X : C} [has_left_dual X] : ᘁ(𝟙 X) = 𝟙 (ᘁX) :=
by simp only [left_adjoint_mate, monoidal_category.tensor_id, category.id_comp,
  evaluation_coevaluation_assoc, category.comp_id, iso.inv_hom_id]

lemma right_adjoint_mate_comp {X Y Z : C} [has_right_dual X]
  [has_right_dual Y] {f : X ⟶ Y} {g : Xᘁ ⟶ Z} :
  fᘁ ≫ g
  = (ρ_ Yᘁ).inv ≫ (𝟙 _ ⊗ η_ X Xᘁ) ≫ (𝟙 _ ⊗ f ⊗ g)
    ≫ (α_ Yᘁ Y Z).inv ≫ (ε_ Y Yᘁ ⊗ 𝟙 _) ≫ (λ_ Z).hom :=
begin
  dunfold right_adjoint_mate,
  rw [category.assoc, category.assoc, associator_inv_naturality_assoc,
    associator_inv_naturality_assoc, ←tensor_id_comp_id_tensor g, category.assoc, category.assoc,
    category.assoc, category.assoc, id_tensor_comp_tensor_id_assoc, ←left_unitor_naturality,
    tensor_id_comp_id_tensor_assoc],
end

lemma left_adjoint_mate_comp {X Y Z : C} [has_left_dual X] [has_left_dual Y]
  {f : X ⟶ Y} {g : ᘁX ⟶ Z} :
  ᘁf ≫ g
  = (λ_ _).inv ≫ (η_ (ᘁX) X ⊗ 𝟙 _) ≫ ((g ⊗ f) ⊗ 𝟙 _)
    ≫ (α_ _ _ _).hom ≫ (𝟙 _ ⊗ ε_ _ _) ≫ (ρ_ _).hom :=
begin
  dunfold left_adjoint_mate,
  rw [category.assoc, category.assoc, associator_naturality_assoc, associator_naturality_assoc,
  ←id_tensor_comp_tensor_id _ g, category.assoc, category.assoc, category.assoc, category.assoc,
  tensor_id_comp_id_tensor_assoc, ←right_unitor_naturality, id_tensor_comp_tensor_id_assoc],
end

/-- The composition of right adjoint mates is the adjoint mate of the composition. -/
@[reassoc]
lemma comp_right_adjoint_mate {X Y Z : C}
  [has_right_dual X] [has_right_dual Y] [has_right_dual Z] {f : X ⟶ Y} {g : Y ⟶ Z} :
  (f ≫ g)ᘁ = gᘁ ≫ fᘁ :=
begin
  rw right_adjoint_mate_comp,
  simp only [right_adjoint_mate, comp_tensor_id, iso.cancel_iso_inv_left, id_tensor_comp,
    category.assoc],
  symmetry, iterate 5 { transitivity, rw [←category.id_comp g, tensor_comp] },
  rw ←category.assoc,
  symmetry, iterate 2 { transitivity, rw ←category.assoc }, apply eq_whisker,
  repeat { rw ←id_tensor_comp }, congr' 1,
  rw [←id_tensor_comp_tensor_id (λ_ Xᘁ).hom g, id_tensor_right_unitor_inv, category.assoc,
    category.assoc, right_unitor_inv_naturality_assoc, ←associator_naturality_assoc, tensor_id,
    tensor_id_comp_id_tensor_assoc, ←associator_naturality_assoc],
  slice_rhs 2 3 { rw [←tensor_comp, tensor_id, category.comp_id,
    ←category.id_comp (η_ Y Yᘁ), tensor_comp] },
  rw [←id_tensor_comp_tensor_id _ (η_ Y Yᘁ), ←tensor_id],
  repeat { rw category.assoc },
  rw [pentagon_hom_inv_assoc, ←associator_naturality_assoc, associator_inv_naturality_assoc],
  slice_rhs 5 7 { rw [←comp_tensor_id, ←comp_tensor_id, evaluation_coevaluation, comp_tensor_id] },
  rw associator_inv_naturality_assoc,
  slice_rhs 4 5 { rw [←tensor_comp, left_unitor_naturality, tensor_comp] },
  repeat { rw category.assoc },
  rw [triangle_assoc_comp_right_inv_assoc, ←left_unitor_tensor_assoc,
    left_unitor_naturality_assoc, unitors_equal, ←category.assoc, ←category.assoc], simp
end

/-- The composition of left adjoint mates is the adjoint mate of the composition. -/
@[reassoc]
lemma comp_left_adjoint_mate {X Y Z : C}
  [has_left_dual X] [has_left_dual Y] [has_left_dual Z] {f : X ⟶ Y} {g : Y ⟶ Z} :
  ᘁ(f ≫ g) = ᘁg ≫ ᘁf :=
begin
  rw left_adjoint_mate_comp,
  simp only [left_adjoint_mate, id_tensor_comp, iso.cancel_iso_inv_left,
    comp_tensor_id, category.assoc],
  symmetry, iterate 5 { transitivity, rw [←category.id_comp g, tensor_comp] },
  rw ← category.assoc,
  symmetry, iterate 2 { transitivity, rw ←category.assoc }, apply eq_whisker,
  repeat { rw ←comp_tensor_id }, congr' 1,
  rw [←tensor_id_comp_id_tensor g (ρ_ (ᘁX)).hom, left_unitor_inv_tensor_id, category.assoc,
    category.assoc, left_unitor_inv_naturality_assoc, ←associator_inv_naturality_assoc, tensor_id,
    id_tensor_comp_tensor_id_assoc, ←associator_inv_naturality_assoc],
  slice_rhs 2 3 { rw [←tensor_comp, tensor_id, category.comp_id,
    ←category.id_comp (η_ (ᘁY) Y), tensor_comp] },
  rw [←tensor_id_comp_id_tensor (η_ (ᘁY) Y), ←tensor_id],
  repeat { rw category.assoc },
  rw [pentagon_inv_hom_assoc, ←associator_inv_naturality_assoc, associator_naturality_assoc],
  slice_rhs 5 7 { rw [←id_tensor_comp, ←id_tensor_comp, coevaluation_evaluation, id_tensor_comp ]},
  rw associator_naturality_assoc,
  slice_rhs 4 5 { rw [←tensor_comp, right_unitor_naturality, tensor_comp] },
  repeat { rw category.assoc },
  rw [triangle_assoc_comp_left_inv_assoc, ←right_unitor_tensor_assoc,
    right_unitor_naturality_assoc, ←unitors_equal, ←category.assoc, ←category.assoc], simp
end

/-- Right duals are isomorphic. -/
def right_dual_iso {X Y₁ Y₂ : C} (_ : exact_pairing X Y₁) (_ : exact_pairing X Y₂) :
  Y₁ ≅ Y₂ :=
{ hom := @right_adjoint_mate C _ _ X X ⟨Y₂⟩ ⟨Y₁⟩ (𝟙 X),
  inv := @right_adjoint_mate C _ _ X X ⟨Y₁⟩ ⟨Y₂⟩ (𝟙 X),
  hom_inv_id' := by rw [←comp_right_adjoint_mate, category.comp_id, right_adjoint_mate_id],
  inv_hom_id' := by rw [←comp_right_adjoint_mate, category.comp_id, right_adjoint_mate_id] }

/-- Left duals are isomorphic. -/
def left_dual_iso {X₁ X₂ Y : C} (p₁ : exact_pairing X₁ Y) (p₂ : exact_pairing X₂ Y) :
  X₁ ≅ X₂ :=
{ hom := @left_adjoint_mate C _ _ Y Y ⟨X₂⟩ ⟨X₁⟩ (𝟙 Y),
  inv := @left_adjoint_mate C _ _ Y Y ⟨X₁⟩ ⟨X₂⟩ (𝟙 Y),
  hom_inv_id' := by rw [←comp_left_adjoint_mate, category.comp_id, left_adjoint_mate_id],
  inv_hom_id' := by rw [←comp_left_adjoint_mate, category.comp_id, left_adjoint_mate_id] }

@[simp]
lemma right_dual_iso_id {X Y : C} (p : exact_pairing X Y) :
  right_dual_iso p p = iso.refl Y :=
by { ext, simp only [right_dual_iso, iso.refl_hom, right_adjoint_mate_id] }

@[simp]
lemma left_dual_iso_id {X Y : C} (p : exact_pairing X Y) :
  left_dual_iso p p = iso.refl X :=
by { ext, simp only [left_dual_iso, iso.refl_hom, left_adjoint_mate_id] }

/-- A right rigid monoidal category is one in which every object has a right dual. -/
class right_rigid_category (C : Type u) [category.{v} C] [monoidal_category.{v} C] :=
[right_dual : Π (X : C), has_right_dual X]

/-- A left rigid monoidal category is one in which every object has a right dual. -/
class left_rigid_category (C : Type u) [category.{v} C] [monoidal_category.{v} C] :=
[left_dual : Π (X : C), has_left_dual X]

attribute [instance, priority 100] right_rigid_category.right_dual
attribute [instance, priority 100] left_rigid_category.left_dual

/-- A rigid monoidal category is a monoidal category which is left rigid and right rigid. -/
class rigid_category (C : Type u) [category.{v} C] [monoidal_category.{v} C]
  extends right_rigid_category C, left_rigid_category C

end category_theory