/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Yaël Dillies
-/
import order.locally_finite
import data.set.intervals.monoid

/-!
# Intervals as finsets

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

This file provides basic results about all the `finset.Ixx`, which are defined in
`order.locally_finite`.

## TODO

This file was originally only about `finset.Ico a b` where `a b : ℕ`. No care has yet been taken to
generalize these lemmas properly and many lemmas about `Icc`, `Ioc`, `Ioo` are missing. In general,
what's to do is taking the lemmas in `data.x.intervals` and abstract away the concrete structure.

Complete the API. See
https://github.com/leanprover-community/mathlib/pull/14448#discussion_r906109235
for some ideas.
-/

open function order_dual
open_locale big_operators finset_interval

variables {ι α : Type*}

namespace finset
section preorder
variables [preorder α]

section locally_finite_order
variables [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α}

@[simp] lemma nonempty_Icc : (Icc a b).nonempty ↔ a ≤ b :=
by rw [←coe_nonempty, coe_Icc, set.nonempty_Icc]

@[simp] lemma nonempty_Ico : (Ico a b).nonempty ↔ a < b :=
by rw [←coe_nonempty, coe_Ico, set.nonempty_Ico]

@[simp] lemma nonempty_Ioc : (Ioc a b).nonempty ↔ a < b :=
by rw [←coe_nonempty, coe_Ioc, set.nonempty_Ioc]

@[simp] lemma nonempty_Ioo [densely_ordered α] : (Ioo a b).nonempty ↔ a < b :=
by rw [←coe_nonempty, coe_Ioo, set.nonempty_Ioo]

@[simp] lemma Icc_eq_empty_iff : Icc a b = ∅ ↔ ¬a ≤ b :=
by rw [←coe_eq_empty, coe_Icc, set.Icc_eq_empty_iff]

@[simp] lemma Ico_eq_empty_iff : Ico a b = ∅ ↔ ¬a < b :=
by rw [←coe_eq_empty, coe_Ico, set.Ico_eq_empty_iff]

@[simp] lemma Ioc_eq_empty_iff : Ioc a b = ∅ ↔ ¬a < b :=
by rw [←coe_eq_empty, coe_Ioc, set.Ioc_eq_empty_iff]

@[simp] lemma Ioo_eq_empty_iff [densely_ordered α] : Ioo a b = ∅ ↔ ¬a < b :=
by rw [←coe_eq_empty, coe_Ioo, set.Ioo_eq_empty_iff]

alias Icc_eq_empty_iff ↔ _ Icc_eq_empty
alias Ico_eq_empty_iff ↔ _ Ico_eq_empty
alias Ioc_eq_empty_iff ↔ _ Ioc_eq_empty

@[simp] lemma Ioo_eq_empty (h : ¬a < b) : Ioo a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x hx, h ((mem_Ioo.1 hx).1.trans (mem_Ioo.1 hx).2)

@[simp] lemma Icc_eq_empty_of_lt (h : b < a) : Icc a b = ∅ := Icc_eq_empty h.not_le
@[simp] lemma Ico_eq_empty_of_le (h : b ≤ a) : Ico a b = ∅ := Ico_eq_empty h.not_lt
@[simp] lemma Ioc_eq_empty_of_le (h : b ≤ a) : Ioc a b = ∅ := Ioc_eq_empty h.not_lt
@[simp] lemma Ioo_eq_empty_of_le (h : b ≤ a) : Ioo a b = ∅ := Ioo_eq_empty h.not_lt

@[simp] lemma left_mem_Icc : a ∈ Icc a b ↔ a ≤ b := by simp only [mem_Icc, true_and, le_rfl]
@[simp] lemma left_mem_Ico : a ∈ Ico a b ↔ a < b := by simp only [mem_Ico, true_and, le_refl]
@[simp] lemma right_mem_Icc : b ∈ Icc a b ↔ a ≤ b := by simp only [mem_Icc, and_true, le_rfl]
@[simp] lemma right_mem_Ioc : b ∈ Ioc a b ↔ a < b := by simp only [mem_Ioc, and_true, le_rfl]

@[simp] lemma left_not_mem_Ioc : a ∉ Ioc a b := λ h, lt_irrefl _ (mem_Ioc.1 h).1
@[simp] lemma left_not_mem_Ioo : a ∉ Ioo a b := λ h, lt_irrefl _ (mem_Ioo.1 h).1
@[simp] lemma right_not_mem_Ico : b ∉ Ico a b := λ h, lt_irrefl _ (mem_Ico.1 h).2
@[simp] lemma right_not_mem_Ioo : b ∉ Ioo a b := λ h, lt_irrefl _ (mem_Ioo.1 h).2

lemma Icc_subset_Icc (ha : a₂ ≤ a₁) (hb : b₁ ≤ b₂) : Icc a₁ b₁ ⊆ Icc a₂ b₂ :=
by simpa [←coe_subset] using set.Icc_subset_Icc ha hb

lemma Ico_subset_Ico (ha : a₂ ≤ a₁) (hb : b₁ ≤ b₂) : Ico a₁ b₁ ⊆ Ico a₂ b₂ :=
by simpa [←coe_subset] using set.Ico_subset_Ico ha hb

lemma Ioc_subset_Ioc (ha : a₂ ≤ a₁) (hb : b₁ ≤ b₂) : Ioc a₁ b₁ ⊆ Ioc a₂ b₂ :=
by simpa [←coe_subset] using set.Ioc_subset_Ioc ha hb

lemma Ioo_subset_Ioo (ha : a₂ ≤ a₁) (hb : b₁ ≤ b₂) : Ioo a₁ b₁ ⊆ Ioo a₂ b₂ :=
by simpa [←coe_subset] using set.Ioo_subset_Ioo ha hb

lemma Ico_subset_Ioo_left (h : a₁ < a₂) : Ico a₂ b ⊆ Ioo a₁ b :=
by { rw [←coe_subset, coe_Ico, coe_Ioo], exact set.Ico_subset_Ioo_left h }

lemma Ioc_subset_Ioo_right (h : b₁ < b₂) : Ioc a b₁ ⊆ Ioo a b₂ :=
by { rw [←coe_subset, coe_Ioc, coe_Ioo], exact set.Ioc_subset_Ioo_right h }

lemma Icc_subset_Ico_right (h : b₁ < b₂) : Icc a b₁ ⊆ Ico a b₂ :=
by { rw [←coe_subset, coe_Icc, coe_Ico], exact set.Icc_subset_Ico_right h }

lemma Ioo_subset_Ico_self : Ioo a b ⊆ Ico a b :=
by { rw [←coe_subset, coe_Ioo, coe_Ico], exact set.Ioo_subset_Ico_self }

lemma Ioo_subset_Ioc_self : Ioo a b ⊆ Ioc a b :=
by { rw [←coe_subset, coe_Ioo, coe_Ioc], exact set.Ioo_subset_Ioc_self }

lemma Ico_subset_Icc_self : Ico a b ⊆ Icc a b :=
by { rw [←coe_subset, coe_Ico, coe_Icc], exact set.Ico_subset_Icc_self }

lemma Ioc_subset_Icc_self : Ioc a b ⊆ Icc a b :=
by { rw [←coe_subset, coe_Ioc, coe_Icc], exact set.Ioc_subset_Icc_self }

lemma Ioo_subset_Icc_self : Ioo a b ⊆ Icc a b := Ioo_subset_Ico_self.trans Ico_subset_Icc_self

lemma Icc_subset_Icc_iff (h₁ : a₁ ≤ b₁) : Icc a₁ b₁ ⊆ Icc a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
by rw [←coe_subset, coe_Icc, coe_Icc, set.Icc_subset_Icc_iff h₁]

lemma Icc_subset_Ioo_iff (h₁ : a₁ ≤ b₁) : Icc a₁ b₁ ⊆ Ioo a₂ b₂ ↔ a₂ < a₁ ∧ b₁ < b₂ :=
by rw [←coe_subset, coe_Icc, coe_Ioo, set.Icc_subset_Ioo_iff h₁]

lemma Icc_subset_Ico_iff (h₁ : a₁ ≤ b₁) : Icc a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ < b₂ :=
by rw [←coe_subset, coe_Icc, coe_Ico, set.Icc_subset_Ico_iff h₁]

lemma Icc_subset_Ioc_iff (h₁ : a₁ ≤ b₁) : Icc a₁ b₁ ⊆ Ioc a₂ b₂ ↔ a₂ < a₁ ∧ b₁ ≤ b₂ :=
(Icc_subset_Ico_iff h₁.dual).trans and.comm

--TODO: `Ico_subset_Ioo_iff`, `Ioc_subset_Ioo_iff`

lemma Icc_ssubset_Icc_left (hI : a₂ ≤ b₂) (ha : a₂ < a₁) (hb : b₁ ≤ b₂) : Icc a₁ b₁ ⊂ Icc a₂ b₂ :=
by { rw [←coe_ssubset, coe_Icc, coe_Icc], exact set.Icc_ssubset_Icc_left hI ha hb }

lemma Icc_ssubset_Icc_right (hI : a₂ ≤ b₂) (ha : a₂ ≤ a₁) (hb : b₁ < b₂) : Icc a₁ b₁ ⊂ Icc a₂ b₂ :=
by { rw [←coe_ssubset, coe_Icc, coe_Icc], exact set.Icc_ssubset_Icc_right hI ha hb }

variables (a)

@[simp] lemma Ico_self : Ico a a = ∅ := Ico_eq_empty $ lt_irrefl _
@[simp] lemma Ioc_self : Ioc a a = ∅ := Ioc_eq_empty $ lt_irrefl _
@[simp] lemma Ioo_self : Ioo a a = ∅ := Ioo_eq_empty $ lt_irrefl _

variables {a}

/-- A set with upper and lower bounds in a locally finite order is a fintype -/
def _root_.set.fintype_of_mem_bounds {s : set α} [decidable_pred (∈ s)]
  (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) : fintype s :=
set.fintype_subset (set.Icc a b) $ λ x hx, ⟨ha hx, hb hx⟩

lemma _root_.bdd_below.finite_of_bdd_above {s : set α} (h₀ : bdd_below s) (h₁ : bdd_above s) :
  s.finite :=
let ⟨a, ha⟩ := h₀, ⟨b, hb⟩ := h₁ in by { classical, exact ⟨set.fintype_of_mem_bounds ha hb⟩ }

section filter

lemma Ico_filter_lt_of_le_left [decidable_pred (< c)] (hca : c ≤ a) : (Ico a b).filter (< c) = ∅ :=
filter_false_of_mem (λ x hx, (hca.trans (mem_Ico.1 hx).1).not_lt)

lemma Ico_filter_lt_of_right_le [decidable_pred (< c)] (hbc : b ≤ c) :
  (Ico a b).filter (< c) = Ico a b :=
filter_true_of_mem (λ x hx, (mem_Ico.1 hx).2.trans_le hbc)

lemma Ico_filter_lt_of_le_right [decidable_pred (< c)] (hcb : c ≤ b) :
  (Ico a b).filter (< c) = Ico a c :=
begin
  ext x,
  rw [mem_filter, mem_Ico, mem_Ico, and.right_comm],
  exact and_iff_left_of_imp (λ h, h.2.trans_le hcb),
end

lemma Ico_filter_le_of_le_left {a b c : α} [decidable_pred ((≤) c)] (hca : c ≤ a) :
  (Ico a b).filter ((≤) c) = Ico a b :=
filter_true_of_mem (λ x hx, hca.trans (mem_Ico.1 hx).1)

lemma Ico_filter_le_of_right_le {a b : α} [decidable_pred ((≤) b)] : (Ico a b).filter ((≤) b) = ∅ :=
filter_false_of_mem (λ x hx, (mem_Ico.1 hx).2.not_le)

lemma Ico_filter_le_of_left_le {a b c : α} [decidable_pred ((≤) c)] (hac : a ≤ c) :
  (Ico a b).filter ((≤) c) = Ico c b :=
begin
  ext x,
  rw [mem_filter, mem_Ico, mem_Ico, and_comm, and.left_comm],
  exact and_iff_right_of_imp (λ h, hac.trans h.1),
end

lemma Icc_filter_lt_of_lt_right {a b c : α} [decidable_pred (< c)] (h : b < c) :
  (Icc a b).filter (< c) = Icc a b :=
(finset.filter_eq_self _).2 (λ x hx, lt_of_le_of_lt (mem_Icc.1 hx).2 h)

lemma Ioc_filter_lt_of_lt_right {a b c : α} [decidable_pred (< c)] (h : b < c) :
  (Ioc a b).filter (< c) = Ioc a b :=
(finset.filter_eq_self _).2 (λ x hx, lt_of_le_of_lt (mem_Ioc.1 hx).2 h)

lemma Iic_filter_lt_of_lt_right {α} [preorder α] [locally_finite_order_bot α]
    {a c : α} [decidable_pred (< c)] (h : a < c) :
  (Iic a).filter (< c) = Iic a :=
(finset.filter_eq_self _).2 (λ x hx, lt_of_le_of_lt (mem_Iic.1 hx) h)

variables (a b) [fintype α]

lemma filter_lt_lt_eq_Ioo [decidable_pred (λ j, a < j ∧ j < b)] :
  univ.filter (λ j, a < j ∧ j < b) = Ioo a b := by { ext, simp }

lemma filter_lt_le_eq_Ioc [decidable_pred (λ j, a < j ∧ j ≤ b)] :
  univ.filter (λ j, a < j ∧ j ≤ b) = Ioc a b := by { ext, simp }

lemma filter_le_lt_eq_Ico [decidable_pred (λ j, a ≤ j ∧ j < b)] :
  univ.filter (λ j, a ≤ j ∧ j < b) = Ico a b := by { ext, simp }

lemma filter_le_le_eq_Icc [decidable_pred (λ j, a ≤ j ∧ j ≤ b)] :
  univ.filter (λ j, a ≤ j ∧ j ≤ b) = Icc a b := by { ext, simp }

end filter

section locally_finite_order_top
variables [locally_finite_order_top α]

lemma Icc_subset_Ici_self : Icc a b ⊆ Ici a := by simpa [←coe_subset] using set.Icc_subset_Ici_self
lemma Ico_subset_Ici_self : Ico a b ⊆ Ici a := by simpa [←coe_subset] using set.Ico_subset_Ici_self
lemma Ioc_subset_Ioi_self : Ioc a b ⊆ Ioi a := by simpa [←coe_subset] using set.Ioc_subset_Ioi_self
lemma Ioo_subset_Ioi_self : Ioo a b ⊆ Ioi a := by simpa [←coe_subset] using set.Ioo_subset_Ioi_self
lemma Ioc_subset_Ici_self : Ioc a b ⊆ Ici a := Ioc_subset_Icc_self.trans Icc_subset_Ici_self
lemma Ioo_subset_Ici_self : Ioo a b ⊆ Ici a := Ioo_subset_Ico_self.trans Ico_subset_Ici_self

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α]

lemma Icc_subset_Iic_self : Icc a b ⊆ Iic b := by simpa [←coe_subset] using set.Icc_subset_Iic_self
lemma Ioc_subset_Iic_self : Ioc a b ⊆ Iic b := by simpa [←coe_subset] using set.Ioc_subset_Iic_self
lemma Ico_subset_Iio_self : Ico a b ⊆ Iio b := by simpa [←coe_subset] using set.Ico_subset_Iio_self
lemma Ioo_subset_Iio_self : Ioo a b ⊆ Iio b := by simpa [←coe_subset] using set.Ioo_subset_Iio_self
lemma Ico_subset_Iic_self : Ico a b ⊆ Iic b := Ico_subset_Icc_self.trans Icc_subset_Iic_self
lemma Ioo_subset_Iic_self : Ioo a b ⊆ Iic b := Ioo_subset_Ioc_self.trans Ioc_subset_Iic_self

end locally_finite_order_bot
end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α] {a : α}

lemma Ioi_subset_Ici_self : Ioi a ⊆ Ici a := by simpa [←coe_subset] using set.Ioi_subset_Ici_self

lemma _root_.bdd_below.finite {s : set α} (hs : bdd_below s) : s.finite :=
let ⟨a, ha⟩ := hs in (Ici a).finite_to_set.subset $ λ x hx, mem_Ici.2 $ ha hx

variables [fintype α]

lemma filter_lt_eq_Ioi [decidable_pred ((<) a)] : univ.filter ((<) a) = Ioi a := by { ext, simp }
lemma filter_le_eq_Ici [decidable_pred ((≤) a)] : univ.filter ((≤) a) = Ici a := by { ext, simp }

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α] {a : α}

lemma Iio_subset_Iic_self : Iio a ⊆ Iic a := by simpa [←coe_subset] using set.Iio_subset_Iic_self

lemma _root_.bdd_above.finite {s : set α} (hs : bdd_above s) : s.finite := hs.dual.finite

variables [fintype α]

lemma filter_gt_eq_Iio [decidable_pred (< a)] : univ.filter (< a) = Iio a := by { ext, simp }
lemma filter_ge_eq_Iic [decidable_pred (≤ a)] : univ.filter (≤ a) = Iic a := by { ext, simp }

end locally_finite_order_bot

variables [locally_finite_order_top α] [locally_finite_order_bot α]

lemma disjoint_Ioi_Iio (a : α) :  disjoint (Ioi a) (Iio a) :=
disjoint_left.2 $ λ b hab hba, (mem_Ioi.1 hab).not_lt $ mem_Iio.1 hba

end preorder

section partial_order
variables [partial_order α] [locally_finite_order α] {a b c : α}

@[simp] lemma Icc_self (a : α) : Icc a a = {a} := by rw [←coe_eq_singleton, coe_Icc, set.Icc_self]

@[simp] lemma Icc_eq_singleton_iff : Icc a b = {c} ↔ a = c ∧ b = c :=
by rw [←coe_eq_singleton, coe_Icc, set.Icc_eq_singleton_iff]

lemma Ico_disjoint_Ico_consecutive (a b c : α) : disjoint (Ico a b) (Ico b c) :=
disjoint_left.2 $ λ x hab hbc, (mem_Ico.mp hab).2.not_le (mem_Ico.mp hbc).1

section decidable_eq
variables [decidable_eq α]

@[simp] lemma Icc_erase_left (a b : α) : (Icc a b).erase a = Ioc a b := by simp [←coe_inj]
@[simp] lemma Icc_erase_right (a b : α) : (Icc a b).erase b = Ico a b := by simp [←coe_inj]
@[simp] lemma Ico_erase_left (a b : α) : (Ico a b).erase a = Ioo a b := by simp [←coe_inj]
@[simp] lemma Ioc_erase_right (a b : α) : (Ioc a b).erase b = Ioo a b := by simp [←coe_inj]
@[simp] lemma Icc_diff_both (a b : α) : Icc a b \ {a, b} = Ioo a b := by simp [←coe_inj]

@[simp] lemma Ico_insert_right (h : a ≤ b) : insert b (Ico a b) = Icc a b :=
by rw [←coe_inj, coe_insert, coe_Icc, coe_Ico, set.insert_eq, set.union_comm, set.Ico_union_right h]

@[simp] lemma Ioc_insert_left (h : a ≤ b) : insert a (Ioc a b) = Icc a b :=
by rw [←coe_inj, coe_insert, coe_Ioc, coe_Icc, set.insert_eq, set.union_comm, set.Ioc_union_left h]

@[simp] lemma Ioo_insert_left (h : a < b) : insert a (Ioo a b) = Ico a b :=
by rw [←coe_inj, coe_insert, coe_Ioo, coe_Ico, set.insert_eq, set.union_comm, set.Ioo_union_left h]

@[simp] lemma Ioo_insert_right (h : a < b) : insert b (Ioo a b) = Ioc a b :=
by rw [←coe_inj, coe_insert, coe_Ioo, coe_Ioc, set.insert_eq, set.union_comm, set.Ioo_union_right h]

@[simp] lemma Icc_diff_Ico_self (h : a ≤ b) : Icc a b \ Ico a b = {b} := by simp [←coe_inj, h]
@[simp] lemma Icc_diff_Ioc_self (h : a ≤ b) : Icc a b \ Ioc a b = {a} := by simp [←coe_inj, h]
@[simp] lemma Icc_diff_Ioo_self (h : a ≤ b) : Icc a b \ Ioo a b = {a, b} := by simp [←coe_inj, h]
@[simp] lemma Ico_diff_Ioo_self (h : a < b) : Ico a b \ Ioo a b = {a} := by simp [←coe_inj, h]
@[simp] lemma Ioc_diff_Ioo_self (h : a < b) : Ioc a b \ Ioo a b = {b} := by simp [←coe_inj, h]

@[simp] lemma Ico_inter_Ico_consecutive (a b c : α) : Ico a b ∩ Ico b c = ∅ :=
(Ico_disjoint_Ico_consecutive a b c).eq_bot

end decidable_eq

-- Those lemmas are purposefully the other way around

/-- `finset.cons` version of `finset.Ico_insert_right`. -/
lemma Icc_eq_cons_Ico (h : a ≤ b) : Icc a b = (Ico a b).cons b right_not_mem_Ico :=
by { classical, rw [cons_eq_insert, Ico_insert_right h] }

/-- `finset.cons` version of `finset.Ioc_insert_left`. -/
lemma Icc_eq_cons_Ioc (h : a ≤ b) : Icc a b = (Ioc a b).cons a left_not_mem_Ioc :=
by { classical, rw [cons_eq_insert, Ioc_insert_left h] }

/-- `finset.cons` version of `finset.Ioo_insert_right`. -/
lemma Ioc_eq_cons_Ioo (h : a < b) : Ioc a b = (Ioo a b).cons b right_not_mem_Ioo :=
by { classical, rw [cons_eq_insert, Ioo_insert_right h], }

/-- `finset.cons` version of `finset.Ioo_insert_left`. -/
lemma Ico_eq_cons_Ioo (h : a < b) : Ico a b = (Ioo a b).cons a left_not_mem_Ioo :=
by { classical, rw [cons_eq_insert, Ioo_insert_left h] }

lemma Ico_filter_le_left {a b : α} [decidable_pred (≤ a)] (hab : a < b) :
  (Ico a b).filter (λ x, x ≤ a) = {a} :=
begin
  ext x,
  rw [mem_filter, mem_Ico, mem_singleton, and.right_comm, ←le_antisymm_iff, eq_comm],
  exact and_iff_left_of_imp (λ h, h.le.trans_lt hab),
end

lemma card_Ico_eq_card_Icc_sub_one (a b : α) : (Ico a b).card = (Icc a b).card - 1 :=
begin
  classical,
  by_cases h : a ≤ b,
  { rw [Icc_eq_cons_Ico h, card_cons],
    exact (nat.add_sub_cancel _ _).symm },
  { rw [Ico_eq_empty (λ h', h h'.le), Icc_eq_empty h, card_empty, zero_tsub] }
end

lemma card_Ioc_eq_card_Icc_sub_one (a b : α) : (Ioc a b).card = (Icc a b).card - 1 :=
@card_Ico_eq_card_Icc_sub_one αᵒᵈ _ _ _ _

lemma card_Ioo_eq_card_Ico_sub_one (a b : α) : (Ioo a b).card = (Ico a b).card - 1 :=
begin
  classical,
  by_cases h : a < b,
  { rw [Ico_eq_cons_Ioo h, card_cons],
    exact (nat.add_sub_cancel _ _).symm },
  { rw [Ioo_eq_empty h, Ico_eq_empty h, card_empty, zero_tsub] }
end

lemma card_Ioo_eq_card_Ioc_sub_one (a b : α) : (Ioo a b).card = (Ioc a b).card - 1 :=
@card_Ioo_eq_card_Ico_sub_one αᵒᵈ _ _ _ _

lemma card_Ioo_eq_card_Icc_sub_two (a b : α) : (Ioo a b).card = (Icc a b).card - 2 :=
by { rw [card_Ioo_eq_card_Ico_sub_one, card_Ico_eq_card_Icc_sub_one], refl }

end partial_order

section bounded_partial_order
variables [partial_order α]

section order_top
variables [locally_finite_order_top α]

@[simp] lemma Ici_erase [decidable_eq α] (a : α) : (Ici a).erase a = Ioi a :=
by { ext, simp_rw [finset.mem_erase, mem_Ici, mem_Ioi, lt_iff_le_and_ne, and_comm, ne_comm], }
@[simp] lemma Ioi_insert [decidable_eq α] (a : α) : insert a (Ioi a) = Ici a :=
by { ext, simp_rw [finset.mem_insert, mem_Ici, mem_Ioi, le_iff_lt_or_eq, or_comm, eq_comm] }

@[simp] lemma not_mem_Ioi_self {b : α} : b ∉ Ioi b := λ h, lt_irrefl _ (mem_Ioi.1 h)

-- Purposefully written the other way around
/-- `finset.cons` version of `finset.Ioi_insert`. -/
lemma Ici_eq_cons_Ioi (a : α) : Ici a = (Ioi a).cons a not_mem_Ioi_self :=
by { classical, rw [cons_eq_insert, Ioi_insert] }

lemma card_Ioi_eq_card_Ici_sub_one (a : α) : (Ioi a).card = (Ici a).card - 1 :=
by rw [Ici_eq_cons_Ioi, card_cons, add_tsub_cancel_right]

end order_top

section order_bot
variables [locally_finite_order_bot α]

@[simp] lemma Iic_erase [decidable_eq α] (b : α) : (Iic b).erase b = Iio b :=
by { ext, simp_rw [finset.mem_erase, mem_Iic, mem_Iio, lt_iff_le_and_ne, and_comm] }
@[simp] lemma Iio_insert [decidable_eq α] (b : α) : insert b (Iio b) = Iic b :=
by { ext, simp_rw [finset.mem_insert, mem_Iic, mem_Iio, le_iff_lt_or_eq, or_comm] }

@[simp] lemma not_mem_Iio_self {b : α} : b ∉ Iio b := λ h, lt_irrefl _ (mem_Iio.1 h)

-- Purposefully written the other way around
/-- `finset.cons` version of `finset.Iio_insert`. -/
lemma Iic_eq_cons_Iio (b : α) : Iic b = (Iio b).cons b not_mem_Iio_self :=
by { classical, rw [cons_eq_insert, Iio_insert] }

lemma card_Iio_eq_card_Iic_sub_one (a : α) : (Iio a).card = (Iic a).card - 1 :=
by rw [Iic_eq_cons_Iio, card_cons, add_tsub_cancel_right]

end order_bot

end bounded_partial_order

section linear_order
variables [linear_order α]

section locally_finite_order
variables [locally_finite_order α] {a b : α}

lemma Ico_subset_Ico_iff {a₁ b₁ a₂ b₂ : α} (h : a₁ < b₁) :
  Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
by rw [←coe_subset, coe_Ico, coe_Ico, set.Ico_subset_Ico_iff h]

lemma Ico_union_Ico_eq_Ico {a b c : α} (hab : a ≤ b) (hbc : b ≤ c) :
  Ico a b ∪ Ico b c = Ico a c :=
by rw [←coe_inj, coe_union, coe_Ico, coe_Ico, coe_Ico, set.Ico_union_Ico_eq_Ico hab hbc]

@[simp] lemma Ioc_union_Ioc_eq_Ioc {a b c : α} (h₁ : a ≤ b) (h₂ : b ≤ c) :
  Ioc a b ∪ Ioc b c = Ioc a c :=
by rw [←coe_inj, coe_union, coe_Ioc, coe_Ioc, coe_Ioc, set.Ioc_union_Ioc_eq_Ioc h₁ h₂]

lemma Ico_subset_Ico_union_Ico {a b c : α} :
  Ico a c ⊆ Ico a b ∪ Ico b c :=
by { rw [←coe_subset, coe_union, coe_Ico, coe_Ico, coe_Ico], exact set.Ico_subset_Ico_union_Ico }

lemma Ico_union_Ico' {a b c d : α} (hcb : c ≤ b) (had : a ≤ d) :
  Ico a b ∪ Ico c d = Ico (min a c) (max b d) :=
by rw [←coe_inj, coe_union, coe_Ico, coe_Ico, coe_Ico, set.Ico_union_Ico' hcb had]

lemma Ico_union_Ico {a b c d : α} (h₁ : min a b ≤ max c d) (h₂ : min c d ≤ max a b) :
  Ico a b ∪ Ico c d = Ico (min a c) (max b d) :=
by rw [←coe_inj, coe_union, coe_Ico, coe_Ico, coe_Ico, set.Ico_union_Ico h₁ h₂]

lemma Ico_inter_Ico {a b c d : α} : Ico a b ∩ Ico c d = Ico (max a c) (min b d) :=
by rw [←coe_inj, coe_inter, coe_Ico, coe_Ico, coe_Ico, ←inf_eq_min, ←sup_eq_max, set.Ico_inter_Ico]

@[simp] lemma Ico_filter_lt (a b c : α) : (Ico a b).filter (λ x, x < c) = Ico a (min b c) :=
begin
  cases le_total b c,
  { rw [Ico_filter_lt_of_right_le h, min_eq_left h] },
  { rw [Ico_filter_lt_of_le_right h, min_eq_right h] }
end

@[simp] lemma Ico_filter_le (a b c : α) : (Ico a b).filter (λ x, c ≤ x) = Ico (max a c) b :=
begin
  cases le_total a c,
  { rw [Ico_filter_le_of_left_le h, max_eq_right h] },
  { rw [Ico_filter_le_of_le_left h, max_eq_left h] }
end

@[simp] lemma Ioo_filter_lt (a b c : α) : (Ioo a b).filter (< c) = Ioo a (min b c) :=
by { ext, simp [and_assoc] }

@[simp] lemma Iio_filter_lt {α} [linear_order α] [locally_finite_order_bot α] (a b : α) :
  (Iio a).filter (< b) = Iio (min a b) :=
by { ext, simp [and_assoc] }

@[simp] lemma Ico_diff_Ico_left (a b c : α) : (Ico a b) \ (Ico a c) = Ico (max a c) b :=
begin
  cases le_total a c,
  { ext x,
    rw [mem_sdiff, mem_Ico, mem_Ico, mem_Ico, max_eq_right h, and.right_comm, not_and, not_lt],
    exact and_congr_left' ⟨λ hx, hx.2 hx.1, λ hx, ⟨h.trans hx, λ _, hx⟩⟩ },
  { rw [Ico_eq_empty_of_le h, sdiff_empty, max_eq_left h] }
end

@[simp] lemma Ico_diff_Ico_right (a b c : α) : (Ico a b) \ (Ico c b) = Ico a (min b c) :=
begin
  cases le_total b c,
  { rw [Ico_eq_empty_of_le h, sdiff_empty, min_eq_left h] },
  { ext x,
    rw [mem_sdiff, mem_Ico, mem_Ico, mem_Ico, min_eq_right h, and_assoc, not_and', not_le],
    exact and_congr_right' ⟨λ hx, hx.2 hx.1, λ hx, ⟨hx.trans_le h, λ _, hx⟩⟩ }
end

end locally_finite_order

variables [fintype α] [locally_finite_order_top α] [locally_finite_order_bot α]

lemma Ioi_disj_union_Iio (a : α) :
  (Ioi a).disj_union (Iio a) (disjoint_Ioi_Iio a) = ({a} : finset α)ᶜ :=
by { ext, simp [eq_comm] }

end linear_order

section lattice
variables [lattice α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α}

lemma uIcc_to_dual (a b : α) : [to_dual a, to_dual b] = [a, b].map to_dual.to_embedding :=
Icc_to_dual _ _

@[simp] lemma uIcc_of_le (h : a ≤ b) : [a, b] = Icc a b :=
by rw [uIcc, inf_eq_left.2 h, sup_eq_right.2 h]

@[simp] lemma uIcc_of_ge (h : b ≤ a) : [a, b] = Icc b a :=
by rw [uIcc, inf_eq_right.2 h, sup_eq_left.2 h]

lemma uIcc_comm (a b : α) : [a, b] = [b, a] := by rw [uIcc, uIcc, inf_comm, sup_comm]

@[simp] lemma uIcc_self : [a, a] = {a} := by simp [uIcc]

@[simp] lemma nonempty_uIcc : finset.nonempty [a, b] := nonempty_Icc.2 inf_le_sup

lemma Icc_subset_uIcc : Icc a b ⊆ [a, b] := Icc_subset_Icc inf_le_left le_sup_right
lemma Icc_subset_uIcc' : Icc b a ⊆ [a, b] := Icc_subset_Icc inf_le_right le_sup_left

@[simp] lemma left_mem_uIcc : a ∈ [a, b] := mem_Icc.2 ⟨inf_le_left, le_sup_left⟩
@[simp] lemma right_mem_uIcc : b ∈ [a, b] := mem_Icc.2 ⟨inf_le_right, le_sup_right⟩

lemma mem_uIcc_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] := Icc_subset_uIcc $ mem_Icc.2 ⟨ha, hb⟩
lemma mem_uIcc_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] := Icc_subset_uIcc' $ mem_Icc.2 ⟨hb, ha⟩

lemma uIcc_subset_uIcc (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] :=
by { rw mem_uIcc at h₁ h₂, exact Icc_subset_Icc (le_inf h₁.1 h₂.1) (sup_le h₁.2 h₂.2) }

lemma uIcc_subset_Icc (ha : a₁ ∈ Icc a₂ b₂) (hb : b₁ ∈ Icc a₂ b₂) : [a₁, b₁] ⊆ Icc a₂ b₂ :=
by { rw mem_Icc at ha hb, exact Icc_subset_Icc (le_inf ha.1 hb.1) (sup_le ha.2 hb.2) }

lemma uIcc_subset_uIcc_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] :=
⟨λ h, ⟨h left_mem_uIcc, h right_mem_uIcc⟩, λ h, uIcc_subset_uIcc h.1 h.2⟩

lemma uIcc_subset_uIcc_iff_le' : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₂ ⊓ b₂ ≤ a₁ ⊓ b₁ ∧ a₁ ⊔ b₁ ≤ a₂ ⊔ b₂ :=
Icc_subset_Icc_iff inf_le_sup

lemma uIcc_subset_uIcc_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] := uIcc_subset_uIcc h right_mem_uIcc
lemma uIcc_subset_uIcc_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] := uIcc_subset_uIcc left_mem_uIcc h

end lattice

section distrib_lattice
variables [distrib_lattice α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α}

lemma eq_of_mem_uIcc_of_mem_uIcc : a ∈ [b, c] → b ∈ [a, c] → a = b :=
by { simp_rw mem_uIcc, exact set.eq_of_mem_uIcc_of_mem_uIcc }

lemma eq_of_mem_uIcc_of_mem_uIcc' : b ∈ [a, c] → c ∈ [a, b] → b = c :=
by { simp_rw mem_uIcc, exact set.eq_of_mem_uIcc_of_mem_uIcc' }

lemma uIcc_injective_right (a : α) : injective (λ b, [b, a]) :=
λ b c h, by { rw ext_iff at h,
  exact eq_of_mem_uIcc_of_mem_uIcc ((h _).1 left_mem_uIcc) ((h _).2 left_mem_uIcc) }

lemma uIcc_injective_left (a : α) : injective (uIcc a) :=
by simpa only [uIcc_comm] using uIcc_injective_right a

end distrib_lattice

section linear_order
variables [linear_order α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α}

lemma Icc_min_max : Icc (min a b) (max a b) = [a, b] := rfl

lemma uIcc_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a := uIcc_of_ge $ le_of_not_ge h
lemma uIcc_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b := uIcc_of_le $ le_of_not_ge h

lemma uIcc_eq_union : [a, b] = Icc a b ∪ Icc b a :=
coe_injective $ by { push_cast, exact set.uIcc_eq_union }

lemma mem_uIcc' : a ∈ [b, c] ↔ b ≤ a ∧ a ≤ c ∨ c ≤ a ∧ a ≤ b := by simp [uIcc_eq_union]

lemma not_mem_uIcc_of_lt : c < a → c < b → c ∉ [a, b] :=
by { rw mem_uIcc, exact set.not_mem_uIcc_of_lt }

lemma not_mem_uIcc_of_gt : a < c → b < c → c ∉ [a, b] :=
by { rw mem_uIcc, exact set.not_mem_uIcc_of_gt }

lemma uIcc_subset_uIcc_iff_le :
  [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
uIcc_subset_uIcc_iff_le'

/-- A sort of triangle inequality. -/
lemma uIcc_subset_uIcc_union_uIcc : [a, c] ⊆ [a, b] ∪ [b, c] :=
coe_subset.1 $ by { push_cast, exact set.uIcc_subset_uIcc_union_uIcc }

end linear_order

section ordered_cancel_add_comm_monoid
variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [locally_finite_order α]

@[simp] lemma map_add_left_Icc (a b c : α) :
  (Icc a b).map (add_left_embedding c) = Icc (c + a) (c + b) :=
by { rw [← coe_inj, coe_map, coe_Icc, coe_Icc], exact set.image_const_add_Icc _ _ _ }

@[simp] lemma map_add_right_Icc (a b c : α) :
  (Icc a b).map (add_right_embedding c) = Icc (a + c) (b + c) :=
by { rw [← coe_inj, coe_map, coe_Icc, coe_Icc], exact set.image_add_const_Icc _ _ _ }

@[simp] lemma map_add_left_Ico (a b c : α) :
  (Ico a b).map (add_left_embedding c) = Ico (c + a) (c + b) :=
by { rw [← coe_inj, coe_map, coe_Ico, coe_Ico], exact set.image_const_add_Ico _ _ _ }

@[simp] lemma map_add_right_Ico (a b c : α) :
  (Ico a b).map (add_right_embedding c) = Ico (a + c) (b + c) :=
by { rw [← coe_inj, coe_map, coe_Ico, coe_Ico], exact set.image_add_const_Ico _ _ _ }

@[simp] lemma map_add_left_Ioc (a b c : α) :
  (Ioc a b).map (add_left_embedding c) = Ioc (c + a) (c + b) :=
by { rw [← coe_inj, coe_map, coe_Ioc, coe_Ioc], exact set.image_const_add_Ioc _ _ _ }

@[simp] lemma map_add_right_Ioc (a b c : α) :
  (Ioc a b).map (add_right_embedding c) = Ioc (a + c) (b + c) :=
by { rw [← coe_inj, coe_map, coe_Ioc, coe_Ioc], exact set.image_add_const_Ioc _ _ _ }

@[simp] lemma map_add_left_Ioo (a b c : α) :
  (Ioo a b).map (add_left_embedding c) = Ioo (c + a) (c + b) :=
by { rw [← coe_inj, coe_map, coe_Ioo, coe_Ioo], exact set.image_const_add_Ioo _ _ _ }

@[simp] lemma map_add_right_Ioo (a b c : α) :
  (Ioo a b).map (add_right_embedding c) = Ioo (a + c) (b + c) :=
by { rw [← coe_inj, coe_map, coe_Ioo, coe_Ioo], exact set.image_add_const_Ioo _ _ _ }

variables [decidable_eq α]

@[simp] lemma image_add_left_Icc (a b c : α) : (Icc a b).image ((+) c) = Icc (c + a) (c + b) :=
by { rw [← map_add_left_Icc, map_eq_image], refl }

@[simp] lemma image_add_left_Ico (a b c : α) : (Ico a b).image ((+) c) = Ico (c + a) (c + b) :=
by { rw [← map_add_left_Ico, map_eq_image], refl }

@[simp] lemma image_add_left_Ioc (a b c : α) : (Ioc a b).image ((+) c) = Ioc (c + a) (c + b) :=
by { rw [← map_add_left_Ioc, map_eq_image], refl }

@[simp] lemma image_add_left_Ioo (a b c : α) : (Ioo a b).image ((+) c) = Ioo (c + a) (c + b) :=
by { rw [← map_add_left_Ioo, map_eq_image], refl }

@[simp] lemma image_add_right_Icc (a b c : α) : (Icc a b).image (+ c) = Icc (a + c) (b + c) :=
by { rw [← map_add_right_Icc, map_eq_image], refl }

lemma image_add_right_Ico (a b c : α) : (Ico a b).image (+ c) = Ico (a + c) (b + c) :=
by { rw [← map_add_right_Ico, map_eq_image], refl }

lemma image_add_right_Ioc (a b c : α) : (Ioc a b).image (+ c) = Ioc (a + c) (b + c) :=
by { rw [← map_add_right_Ioc, map_eq_image], refl }

lemma image_add_right_Ioo (a b c : α) : (Ioo a b).image (+ c) = Ioo (a + c) (b + c) :=
by { rw [← map_add_right_Ioo, map_eq_image], refl }

end ordered_cancel_add_comm_monoid

@[to_additive] lemma prod_prod_Ioi_mul_eq_prod_prod_off_diag [fintype ι] [linear_order ι]
  [locally_finite_order_top ι] [locally_finite_order_bot ι] [comm_monoid α] (f : ι → ι → α) :
  ∏ i, ∏ j in Ioi i, f j i * f i j = ∏ i, ∏ j in {i}ᶜ, f j i :=
begin
  simp_rw [←Ioi_disj_union_Iio, prod_disj_union, prod_mul_distrib],
  congr' 1,
  rw [prod_sigma', prod_sigma'],
  refine prod_bij' (λ i hi, ⟨i.2, i.1⟩) _ _ (λ i hi, ⟨i.2, i.1⟩) _ _ _; simp,
end

end finset


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

/-!
# Boolean quantifiers

This proves a few properties about `list.all` and `list.any`, which are the `bool` universal and
existential quantifiers. Their definitions are in core Lean.
-/

variables {α : Type*} {p : α → Prop} [decidable_pred p] {l : list α} {a : α}

namespace list

@[simp] theorem all_nil (p : α → bool) : all [] p = tt := rfl

@[simp] theorem all_cons (p : α → bool) (a : α) (l : list α) : all (a::l) p = (p a && all l p) :=
rfl

theorem all_iff_forall {p : α → bool} : all l p ↔ ∀ a ∈ l, p a :=
begin
  induction l with a l ih,
  { exact iff_of_true rfl (forall_mem_nil _) },
  simp only [all_cons, band_coe_iff, ih, forall_mem_cons]
end

theorem all_iff_forall_prop : all l (λ a, p a) ↔ ∀ a ∈ l, p a :=
by simp only [all_iff_forall, bool.of_to_bool_iff]

@[simp] theorem any_nil (p : α → bool) : any [] p = ff := rfl

@[simp] theorem any_cons (p : α → bool) (a : α) (l : list α) : any (a :: l) p = (p a || any l p) :=
rfl

theorem any_iff_exists {p : α → bool} : any l p ↔ ∃ a ∈ l, p a :=
begin
  induction l with a l ih,
  { exact iff_of_false bool.not_ff (not_exists_mem_nil _) },
  simp only [any_cons, bor_coe_iff, ih, exists_mem_cons_iff]
end

theorem any_iff_exists_prop : any l (λ a, p a) ↔ ∃ a ∈ l, p a := by simp [any_iff_exists]

theorem any_of_mem {p : α → bool} (h₁ : a ∈ l) (h₂ : p a) : any l p := any_iff_exists.2 ⟨_, h₁, h₂⟩

@[priority 500] instance decidable_forall_mem (l : list α) : decidable (∀ x ∈ l, p x) :=
decidable_of_iff _ all_iff_forall_prop

instance decidable_exists_mem (l : list α) : decidable (∃ x ∈ l, p x) :=
decidable_of_iff _ any_iff_exists_prop

end list


universe u

private definition eqv {α : Type u} (p₁ p₂ : α × α) : Prop :=
(p₁.1 = p₂.1 ∧ p₁.2 = p₂.2) ∨ (p₁.1 = p₂.2 ∧ p₁.2 = p₂.1)

local infix `~` := eqv

open or

private theorem eqv.refl {α : Type u} : ∀ p : α × α, p ~ p :=
assume p, inl ⟨rfl, rfl⟩

private theorem eqv.symm {α : Type u} : ∀ p₁ p₂ : α × α, p₁ ~ p₂ → p₂ ~ p₁
| (a₁, a₂) (b₁, b₂) (inl ⟨a₁b₁, a₂b₂⟩) := inl ⟨symm a₁b₁, symm a₂b₂⟩
| (a₁, a₂) (b₁, b₂) (inr ⟨a₁b₂, a₂b₁⟩) := inr ⟨symm a₂b₁, symm a₁b₂⟩

private theorem eqv.trans {α : Type u} : ∀ p₁ p₂ p₃ : α × α, p₁ ~ p₂ → p₂ ~ p₃ → p₁ ~ p₃
| (a₁, a₂) (b₁, b₂) (c₁, c₂) (inl ⟨a₁b₁, a₂b₂⟩) (inl ⟨b₁c₁, b₂c₂⟩) :=
  inl ⟨trans a₁b₁ b₁c₁, trans a₂b₂ b₂c₂⟩
| (a₁, a₂) (b₁, b₂) (c₁, c₂) (inl ⟨a₁b₁, a₂b₂⟩) (inr ⟨b₁c₂, b₂c₁⟩) :=
  inr ⟨trans a₁b₁ b₁c₂, trans a₂b₂ b₂c₁⟩
| (a₁, a₂) (b₁, b₂) (c₁, c₂) (inr ⟨a₁b₂, a₂b₁⟩) (inl ⟨b₁c₁, b₂c₂⟩) :=
  inr ⟨trans a₁b₂ b₂c₂, trans a₂b₁ b₁c₁⟩
| (a₁, a₂) (b₁, b₂) (c₁, c₂) (inr ⟨a₁b₂, a₂b₁⟩) (inr ⟨b₁c₂, b₂c₁⟩) :=
  inl ⟨trans a₁b₂ b₂c₁, trans a₂b₁ b₁c₂⟩

private theorem is_equivalence (α : Type u) : equivalence (@eqv α) :=
mk_equivalence (@eqv α) (@eqv.refl α) (@eqv.symm α) (@eqv.trans α)

instance uprod.setoid (α : Type u) : setoid (α × α) :=
setoid.mk (@eqv α) (is_equivalence α)

definition uprod (α : Type u) : Type u :=
quotient (uprod.setoid α)

namespace uprod
  definition mk {α : Type u} (a₁ a₂ : α) : uprod α :=
  ⟦(a₁, a₂)⟧

  local notation `{` a₁ `,` a₂ `}` := mk a₁ a₂

  theorem mk_eq_mk {α : Type} (a₁ a₂ : α) : {a₁, a₂} = {a₂, a₁} :=
  quot.sound (inr ⟨rfl, rfl⟩)

  private definition mem_fn {α : Type} (a : α) :
    α × α → Prop
  | (a₁, a₂) := a = a₁ ∨ a = a₂

  -- auxiliary lemma for proving mem_respects
  private lemma mem_swap {α : Type} {a : α} :
    ∀ {p : α × α}, mem_fn a p = mem_fn a (⟨p.2, p.1⟩)
  | (a₁, a₂) := propext (iff.intro
      (λ l : a = a₁ ∨ a = a₂,
        or.elim l (λ h₁, inr h₁) (λ h₂, inl h₂))
      (λ r : a = a₂ ∨ a = a₁,
        or.elim r (λ h₁, inr h₁) (λ h₂, inl h₂)))

  private lemma mem_respects {α : Type} :
    ∀ {p₁ p₂ : α × α} (a : α),
      p₁ ~ p₂ → mem_fn a p₁ = mem_fn a p₂
  | (a₁, a₂) (b₁, b₂) a (inl ⟨a₁b₁, a₂b₂⟩) :=
    by { dsimp at a₁b₁, dsimp at a₂b₂, rw [a₁b₁, a₂b₂] }
  | (a₁, a₂) (b₁, b₂) a (inr ⟨a₁b₂, a₂b₁⟩) :=
    by { dsimp at a₁b₂, dsimp at a₂b₁, rw [a₁b₂, a₂b₁],
          apply mem_swap }

  def mem {α : Type} (a : α) (u : uprod α) : Prop :=
  quot.lift_on u (λ p, mem_fn a p) (λ p₁ p₂ e, mem_respects a e)

  local infix `∈` := mem

  theorem mem_mk_left {α : Type} (a b : α) : a ∈ {a, b} :=
  inl rfl

  theorem mem_mk_right {α : Type} (a b : α) : b ∈ {a, b} :=
  inr rfl

  theorem mem_or_mem_of_mem_mk {α : Type} {a b c : α} :
    c ∈ {a, b} → c = a ∨ c = b :=
  λ h, h
end uprod


/- Missing bits that should be added to mathlib after the workshop and after cleaning them up -/

import geometry.manifold.cont_mdiff
import geometry.manifold.instances.real

open set

open_locale big_operators ennreal

section pi_Lp_smooth

variables
  {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {ι : Type*} [fintype ι]
  {p : ℝ≥0∞} [hp : fact (1 ≤ p)] {α : ι → Type*} {n : with_top ℕ} (i : ι)
  [∀i, normed_add_comm_group (α i)] [∀i, normed_space 𝕜 (α i)]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {f : E → pi_Lp p α} {s : set E} {x : E}

include hp

lemma pi_Lp.norm_coord_le_norm (x : pi_Lp p α) (i : ι) : ‖x i‖ ≤ ‖x‖ :=
begin
  unfreezingI { rcases p.trichotomy with (rfl | rfl | h) },
  { exact false.elim (lt_irrefl _ (ennreal.zero_lt_one.trans_le hp.out)) },
  { rw pi_Lp.norm_eq_csupr,
    exact le_cSup (finite_range _).bdd_above (mem_range_self _) },
  { calc
    ‖x i‖ ≤ (‖x i‖ ^ p.to_real) ^ (1/p.to_real) :
      by rw [← real.rpow_mul (norm_nonneg _), mul_one_div_cancel h.ne', real.rpow_one]
    ... ≤ _ :
    begin
      have A : ∀ j, 0 ≤ ‖x j‖ ^ p.to_real := λ j, real.rpow_nonneg_of_nonneg (norm_nonneg _) _,
      simp only [pi_Lp.norm_eq_sum h, one_mul, linear_map.coe_mk],
      apply real.rpow_le_rpow (A i),
      { exact finset.single_le_sum (λ j hj, A j) (finset.mem_univ _) },
      { exact div_nonneg zero_le_one h.le, }
    end }
end

lemma pi_Lp.cont_diff_coord :
  cont_diff 𝕜 n (λ x : pi_Lp p α, x i) :=
let F : pi_Lp p α →ₗ[𝕜] α i :=
{ to_fun := λ x, x i, map_add' := λ x y, rfl, map_smul' := λ x c, rfl } in
(F.mk_continuous 1 (λ x, by simpa using pi_Lp.norm_coord_le_norm x i)).cont_diff

lemma pi_Lp.cont_diff_within_at_iff_coord :
  cont_diff_within_at 𝕜 n f s x ↔ ∀ i, cont_diff_within_at 𝕜 n (λ x, (f x) i) s x:=
begin
  classical,
  split,
  { assume h i,
    have : cont_diff 𝕜 n (λ (x : pi_Lp p α), x i) := pi_Lp.cont_diff_coord i,
    exact this.comp_cont_diff_within_at h },
  { assume h,
    let F : Π (i : ι), α i →ₗ[𝕜] pi_Lp p α := λ i,
    { to_fun := λ y, function.update 0 i y,
      map_add' :=
      begin
        assume y y',
        ext j,
        by_cases h : j = i,
        { rw h, simp },
        { simp [h], }
      end,
      map_smul' :=
      begin
        assume c x,
        ext j,
        by_cases h : j = i,
        { rw h, simp },
        { simp [h], }
      end },
    let G : Π (i : ι), α i →L[𝕜] pi_Lp p α := λ i,
    begin
      refine (F i).mk_continuous 1 (λ x, _),
      unfreezingI { rcases p.trichotomy with (rfl | rfl | h) },
      { exact false.elim (lt_irrefl _ (ennreal.zero_lt_one.trans_le hp.out)) },
      { haveI : nonempty ι := ⟨i⟩,
        simp only [pi_Lp.norm_eq_csupr, linear_map.coe_mk, one_mul],
        refine cSup_le (range_nonempty _) _,
        simp only [mem_range, forall_exists_index, forall_apply_eq_imp_iff'],
        assume j,
        by_cases hji : j = i,
        { rw hji, simp only [function.update_same] },
        { simp only [hji, function.update_noteq, ne.def, not_false_iff, pi.zero_apply, norm_zero, norm_nonneg] } },
      { have : (λ j, ‖function.update 0 i x j‖ ^ p.to_real) = (λ j, if j = i then ‖x‖ ^ p.to_real else 0),
        { ext j,
          by_cases hji : j = i,
          { rw hji, simp },
          { simp [hji, h.ne'], } },
        simp only [pi_Lp.norm_eq_sum h, this, one_mul, finset.mem_univ, if_true, linear_map.coe_mk, finset.sum_ite_eq'],
        rw [← real.rpow_mul (norm_nonneg _), mul_one_div_cancel h.ne', real.rpow_one], }
    end,
    have : cont_diff_within_at 𝕜 n (λ x, (∑ (i : ι), G i ((f x) i))) s x,
    { apply cont_diff_within_at.sum (λ i hi, _),
      exact (G i).cont_diff.comp_cont_diff_within_at (h i) },
    convert this,
    ext x j,
    simp,
    change f x j = (∑ (i : ι), function.update 0 i (f x i)) j,
    rw finset.sum_apply,
    have : ∀ i, function.update 0 i (f x i) j = (if j = i then f x j else 0),
    { assume i,
      by_cases h : j = i,
      { rw h, simp },
      { simp [h] } },
    simp [this] }
end

lemma pi_Lp.cont_diff_at_iff_coord :
  cont_diff_at 𝕜 n f x ↔ ∀ i, cont_diff_at 𝕜 n (λ x, (f x) i) x :=
by simp [← cont_diff_within_at_univ, pi_Lp.cont_diff_within_at_iff_coord]

lemma pi_Lp.cont_diff_on_iff_coord :
  cont_diff_on 𝕜 n f s ↔ ∀ i, cont_diff_on 𝕜 n (λ x, (f x) i) s :=
by { simp_rw [cont_diff_on, pi_Lp.cont_diff_within_at_iff_coord], tauto }

lemma pi_Lp.cont_diff_iff_coord :
  cont_diff 𝕜 n f ↔ ∀ i, cont_diff 𝕜 n (λ x, (f x) i) :=
by simp [← cont_diff_on_univ, pi_Lp.cont_diff_on_iff_coord]

end pi_Lp_smooth


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

! This file was ported from Lean 3 source module analysis.calculus.iterated_deriv
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.Deriv
import Mathbin.Analysis.Calculus.ContDiff

/-!
# One-dimensional iterated derivatives

We define the `n`-th derivative of a function `f : 𝕜 → F` as a function
`iterated_deriv n f : 𝕜 → F`, as well as a version on domains `iterated_deriv_within n f s : 𝕜 → F`,
and prove their basic properties.

## Main definitions and results

Let `𝕜` be a nontrivially normed field, and `F` a normed vector space over `𝕜`. Let `f : 𝕜 → F`.

* `iterated_deriv n f` is the `n`-th derivative of `f`, seen as a function from `𝕜` to `F`.
  It is defined as the `n`-th Fréchet derivative (which is a multilinear map) applied to the
  vector `(1, ..., 1)`, to take advantage of all the existing framework, but we show that it
  coincides with the naive iterative definition.
* `iterated_deriv_eq_iterate` states that the `n`-th derivative of `f` is obtained by starting
  from `f` and differentiating it `n` times.
* `iterated_deriv_within n f s` is the `n`-th derivative of `f` within the domain `s`. It only
  behaves well when `s` has the unique derivative property.
* `iterated_deriv_within_eq_iterate` states that the `n`-th derivative of `f` in the domain `s` is
  obtained by starting from `f` and differentiating it `n` times within `s`. This only holds when
  `s` has the unique derivative property.

## Implementation details

The results are deduced from the corresponding results for the more general (multilinear) iterated
Fréchet derivative. For this, we write `iterated_deriv n f` as the composition of
`iterated_fderiv 𝕜 n f` and a continuous linear equiv. As continuous linear equivs respect
differentiability and commute with differentiation, this makes it possible to prove readily that
the derivative of the `n`-th derivative is the `n+1`-th derivative in `iterated_deriv_within_succ`,
by translating the corresponding result `iterated_fderiv_within_succ_apply_left` for the
iterated Fréchet derivative.
-/

noncomputable section

open Classical Topology BigOperators

open Filter Asymptotics Set

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜]

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F]

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace 𝕜 E]

/-- The `n`-th iterated derivative of a function from `𝕜` to `F`, as a function from `𝕜` to `F`. -/
def iteratedDeriv (n : ℕ) (f : 𝕜 → F) (x : 𝕜) : F :=
  (iteratedFderiv 𝕜 n f x : (Fin n → 𝕜) → F) fun i : Fin n => 1
#align iterated_deriv iteratedDeriv

/-- The `n`-th iterated derivative of a function from `𝕜` to `F` within a set `s`, as a function
from `𝕜` to `F`. -/
def iteratedDerivWithin (n : ℕ) (f : 𝕜 → F) (s : Set 𝕜) (x : 𝕜) : F :=
  (iteratedFderivWithin 𝕜 n f s x : (Fin n → 𝕜) → F) fun i : Fin n => 1
#align iterated_deriv_within iteratedDerivWithin

variable {n : ℕ} {f : 𝕜 → F} {s : Set 𝕜} {x : 𝕜}

theorem iteratedDerivWithin_univ : iteratedDerivWithin n f univ = iteratedDeriv n f :=
  by
  ext x
  rw [iteratedDerivWithin, iteratedDeriv, iteratedFderivWithin_univ]
#align iterated_deriv_within_univ iteratedDerivWithin_univ

/-! ### Properties of the iterated derivative within a set -/

theorem iteratedDerivWithin_eq_iteratedFderivWithin :
    iteratedDerivWithin n f s x =
      (iteratedFderivWithin 𝕜 n f s x : (Fin n → 𝕜) → F) fun i : Fin n => 1 :=
  rfl
#align iterated_deriv_within_eq_iterated_fderiv_within iteratedDerivWithin_eq_iteratedFderivWithin

/-- Write the iterated derivative as the composition of a continuous linear equiv and the iterated
Fréchet derivative -/
theorem iteratedDerivWithin_eq_equiv_comp :
    iteratedDerivWithin n f s =
      (ContinuousMultilinearMap.piFieldEquiv 𝕜 (Fin n) F).symm ∘ iteratedFderivWithin 𝕜 n f s :=
  by
  ext x
  rfl
#align iterated_deriv_within_eq_equiv_comp iteratedDerivWithin_eq_equiv_comp

/-- Write the iterated Fréchet derivative as the composition of a continuous linear equiv and the
iterated derivative. -/
theorem iteratedFderivWithin_eq_equiv_comp :
    iteratedFderivWithin 𝕜 n f s =
      ContinuousMultilinearMap.piFieldEquiv 𝕜 (Fin n) F ∘ iteratedDerivWithin n f s :=
  by
  rw [iteratedDerivWithin_eq_equiv_comp, ← Function.comp.assoc, LinearIsometryEquiv.self_comp_symm,
    Function.left_id]
#align iterated_fderiv_within_eq_equiv_comp iteratedFderivWithin_eq_equiv_comp

/-- The `n`-th Fréchet derivative applied to a vector `(m 0, ..., m (n-1))` is the derivative
multiplied by the product of the `m i`s. -/
theorem iteratedFderivWithin_apply_eq_iteratedDerivWithin_mul_prod {m : Fin n → 𝕜} :
    (iteratedFderivWithin 𝕜 n f s x : (Fin n → 𝕜) → F) m =
      (∏ i, m i) • iteratedDerivWithin n f s x :=
  by
  rw [iteratedDerivWithin_eq_iteratedFderivWithin, ← ContinuousMultilinearMap.map_smul_univ]
  simp
#align iterated_fderiv_within_apply_eq_iterated_deriv_within_mul_prod iteratedFderivWithin_apply_eq_iteratedDerivWithin_mul_prod

@[simp]
theorem iteratedDerivWithin_zero : iteratedDerivWithin 0 f s = f :=
  by
  ext x
  simp [iteratedDerivWithin]
#align iterated_deriv_within_zero iteratedDerivWithin_zero

@[simp]
theorem iteratedDerivWithin_one (hs : UniqueDiffOn 𝕜 s) {x : 𝕜} (hx : x ∈ s) :
    iteratedDerivWithin 1 f s x = derivWithin f s x :=
  by
  simp [iteratedDerivWithin, iteratedFderivWithin_one_apply hs hx]
  rfl
#align iterated_deriv_within_one iteratedDerivWithin_one

/-- If the first `n` derivatives within a set of a function are continuous, and its first `n-1`
derivatives are differentiable, then the function is `C^n`. This is not an equivalence in general,
but this is an equivalence when the set has unique derivatives, see
`cont_diff_on_iff_continuous_on_differentiable_on_deriv`. -/
theorem contDiffOn_of_continuousOn_differentiableOn_deriv {n : ℕ∞}
    (Hcont : ∀ m : ℕ, (m : ℕ∞) ≤ n → ContinuousOn (fun x => iteratedDerivWithin m f s x) s)
    (Hdiff : ∀ m : ℕ, (m : ℕ∞) < n → DifferentiableOn 𝕜 (fun x => iteratedDerivWithin m f s x) s) :
    ContDiffOn 𝕜 n f s :=
  by
  apply contDiffOn_of_continuousOn_differentiableOn
  · simpa [iteratedFderivWithin_eq_equiv_comp, LinearIsometryEquiv.comp_continuousOn_iff]
  · simpa [iteratedFderivWithin_eq_equiv_comp, LinearIsometryEquiv.comp_differentiableOn_iff]
#align cont_diff_on_of_continuous_on_differentiable_on_deriv contDiffOn_of_continuousOn_differentiableOn_deriv

/-- To check that a function is `n` times continuously differentiable, it suffices to check that its
first `n` derivatives are differentiable. This is slightly too strong as the condition we
require on the `n`-th derivative is differentiability instead of continuity, but it has the
advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal).
-/
theorem contDiffOn_of_differentiableOn_deriv {n : ℕ∞}
    (h : ∀ m : ℕ, (m : ℕ∞) ≤ n → DifferentiableOn 𝕜 (iteratedDerivWithin m f s) s) :
    ContDiffOn 𝕜 n f s := by
  apply contDiffOn_of_differentiableOn
  simpa only [iteratedFderivWithin_eq_equiv_comp, LinearIsometryEquiv.comp_differentiableOn_iff]
#align cont_diff_on_of_differentiable_on_deriv contDiffOn_of_differentiableOn_deriv

/-- On a set with unique derivatives, a `C^n` function has derivatives up to `n` which are
continuous. -/
theorem ContDiffOn.continuousOn_iteratedDerivWithin {n : ℕ∞} {m : ℕ} (h : ContDiffOn 𝕜 n f s)
    (hmn : (m : ℕ∞) ≤ n) (hs : UniqueDiffOn 𝕜 s) : ContinuousOn (iteratedDerivWithin m f s) s := by
  simpa only [iteratedDerivWithin_eq_equiv_comp, LinearIsometryEquiv.comp_continuousOn_iff] using
    h.continuous_on_iterated_fderiv_within hmn hs
#align cont_diff_on.continuous_on_iterated_deriv_within ContDiffOn.continuousOn_iteratedDerivWithin

/-- On a set with unique derivatives, a `C^n` function has derivatives less than `n` which are
differentiable. -/
theorem ContDiffOn.differentiableOn_iteratedDerivWithin {n : ℕ∞} {m : ℕ} (h : ContDiffOn 𝕜 n f s)
    (hmn : (m : ℕ∞) < n) (hs : UniqueDiffOn 𝕜 s) :
    DifferentiableOn 𝕜 (iteratedDerivWithin m f s) s := by
  simpa only [iteratedDerivWithin_eq_equiv_comp,
    LinearIsometryEquiv.comp_differentiableOn_iff] using
    h.differentiable_on_iterated_fderiv_within hmn hs
#align cont_diff_on.differentiable_on_iterated_deriv_within ContDiffOn.differentiableOn_iteratedDerivWithin

/-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be
reformulated in terms of the one-dimensional derivative on sets with unique derivatives. -/
theorem contDiffOn_iff_continuousOn_differentiableOn_deriv {n : ℕ∞} (hs : UniqueDiffOn 𝕜 s) :
    ContDiffOn 𝕜 n f s ↔
      (∀ m : ℕ, (m : ℕ∞) ≤ n → ContinuousOn (iteratedDerivWithin m f s) s) ∧
        ∀ m : ℕ, (m : ℕ∞) < n → DifferentiableOn 𝕜 (iteratedDerivWithin m f s) s :=
  by
  simp only [contDiffOn_iff_continuousOn_differentiableOn hs, iteratedFderivWithin_eq_equiv_comp,
    LinearIsometryEquiv.comp_continuousOn_iff, LinearIsometryEquiv.comp_differentiableOn_iff]
#align cont_diff_on_iff_continuous_on_differentiable_on_deriv contDiffOn_iff_continuousOn_differentiableOn_deriv

/-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by
differentiating the `n`-th iterated derivative. -/
theorem iteratedDerivWithin_succ {x : 𝕜} (hxs : UniqueDiffWithinAt 𝕜 s x) :
    iteratedDerivWithin (n + 1) f s x = derivWithin (iteratedDerivWithin n f s) s x :=
  by
  rw [iteratedDerivWithin_eq_iteratedFderivWithin, iteratedFderivWithin_succ_apply_left,
    iteratedFderivWithin_eq_equiv_comp, LinearIsometryEquiv.comp_fderivWithin _ hxs, derivWithin]
  change
    ((ContinuousMultilinearMap.mkPiField 𝕜 (Fin n)
            ((fderivWithin 𝕜 (iteratedDerivWithin n f s) s x : 𝕜 → F) 1) :
          (Fin n → 𝕜) → F)
        fun i : Fin n => 1) =
      (fderivWithin 𝕜 (iteratedDerivWithin n f s) s x : 𝕜 → F) 1
  simp
#align iterated_deriv_within_succ iteratedDerivWithin_succ

/-- The `n`-th iterated derivative within a set with unique derivatives can be obtained by
iterating `n` times the differentiation operation. -/
theorem iteratedDerivWithin_eq_iterate {x : 𝕜} (hs : UniqueDiffOn 𝕜 s) (hx : x ∈ s) :
    iteratedDerivWithin n f s x = ((fun g : 𝕜 → F => derivWithin g s)^[n]) f x :=
  by
  induction' n with n IH generalizing x
  · simp
  · rw [iteratedDerivWithin_succ (hs x hx), Function.iterate_succ']
    exact derivWithin_congr (hs x hx) (fun y hy => IH hy) (IH hx)
#align iterated_deriv_within_eq_iterate iteratedDerivWithin_eq_iterate

/-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by
taking the `n`-th derivative of the derivative. -/
theorem iteratedDerivWithin_succ' {x : 𝕜} (hxs : UniqueDiffOn 𝕜 s) (hx : x ∈ s) :
    iteratedDerivWithin (n + 1) f s x = (iteratedDerivWithin n (derivWithin f s) s) x :=
  by
  rw [iteratedDerivWithin_eq_iterate hxs hx, iteratedDerivWithin_eq_iterate hxs hx]
  rfl
#align iterated_deriv_within_succ' iteratedDerivWithin_succ'

/-! ### Properties of the iterated derivative on the whole space -/

theorem iteratedDeriv_eq_iteratedFderiv :
    iteratedDeriv n f x = (iteratedFderiv 𝕜 n f x : (Fin n → 𝕜) → F) fun i : Fin n => 1 :=
  rfl
#align iterated_deriv_eq_iterated_fderiv iteratedDeriv_eq_iteratedFderiv

/-- Write the iterated derivative as the composition of a continuous linear equiv and the iterated
Fréchet derivative -/
theorem iteratedDeriv_eq_equiv_comp :
    iteratedDeriv n f =
      (ContinuousMultilinearMap.piFieldEquiv 𝕜 (Fin n) F).symm ∘ iteratedFderiv 𝕜 n f :=
  by
  ext x
  rfl
#align iterated_deriv_eq_equiv_comp iteratedDeriv_eq_equiv_comp

/-- Write the iterated Fréchet derivative as the composition of a continuous linear equiv and the
iterated derivative. -/
theorem iteratedFderiv_eq_equiv_comp :
    iteratedFderiv 𝕜 n f = ContinuousMultilinearMap.piFieldEquiv 𝕜 (Fin n) F ∘ iteratedDeriv n f :=
  by
  rw [iteratedDeriv_eq_equiv_comp, ← Function.comp.assoc, LinearIsometryEquiv.self_comp_symm,
    Function.left_id]
#align iterated_fderiv_eq_equiv_comp iteratedFderiv_eq_equiv_comp

/-- The `n`-th Fréchet derivative applied to a vector `(m 0, ..., m (n-1))` is the derivative
multiplied by the product of the `m i`s. -/
theorem iteratedFderiv_apply_eq_iteratedDeriv_mul_prod {m : Fin n → 𝕜} :
    (iteratedFderiv 𝕜 n f x : (Fin n → 𝕜) → F) m = (∏ i, m i) • iteratedDeriv n f x :=
  by
  rw [iteratedDeriv_eq_iteratedFderiv, ← ContinuousMultilinearMap.map_smul_univ]
  simp
#align iterated_fderiv_apply_eq_iterated_deriv_mul_prod iteratedFderiv_apply_eq_iteratedDeriv_mul_prod

@[simp]
theorem iteratedDeriv_zero : iteratedDeriv 0 f = f :=
  by
  ext x
  simp [iteratedDeriv]
#align iterated_deriv_zero iteratedDeriv_zero

@[simp]
theorem iteratedDeriv_one : iteratedDeriv 1 f = deriv f :=
  by
  ext x
  simp [iteratedDeriv]
  rfl
#align iterated_deriv_one iteratedDeriv_one

/-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be
reformulated in terms of the one-dimensional derivative. -/
theorem contDiff_iff_iteratedDeriv {n : ℕ∞} :
    ContDiff 𝕜 n f ↔
      (∀ m : ℕ, (m : ℕ∞) ≤ n → Continuous (iteratedDeriv m f)) ∧
        ∀ m : ℕ, (m : ℕ∞) < n → Differentiable 𝕜 (iteratedDeriv m f) :=
  by
  simp only [contDiff_iff_continuous_differentiable, iteratedFderiv_eq_equiv_comp,
    LinearIsometryEquiv.comp_continuous_iff, LinearIsometryEquiv.comp_differentiable_iff]
#align cont_diff_iff_iterated_deriv contDiff_iff_iteratedDeriv

/-- To check that a function is `n` times continuously differentiable, it suffices to check that its
first `n` derivatives are differentiable. This is slightly too strong as the condition we
require on the `n`-th derivative is differentiability instead of continuity, but it has the
advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal).
-/
theorem contDiff_of_differentiable_iteratedDeriv {n : ℕ∞}
    (h : ∀ m : ℕ, (m : ℕ∞) ≤ n → Differentiable 𝕜 (iteratedDeriv m f)) : ContDiff 𝕜 n f :=
  contDiff_iff_iteratedDeriv.2 ⟨fun m hm => (h m hm).Continuous, fun m hm => h m (le_of_lt hm)⟩
#align cont_diff_of_differentiable_iterated_deriv contDiff_of_differentiable_iteratedDeriv

theorem ContDiff.continuous_iteratedDeriv {n : ℕ∞} (m : ℕ) (h : ContDiff 𝕜 n f)
    (hmn : (m : ℕ∞) ≤ n) : Continuous (iteratedDeriv m f) :=
  (contDiff_iff_iteratedDeriv.1 h).1 m hmn
#align cont_diff.continuous_iterated_deriv ContDiff.continuous_iteratedDeriv

theorem ContDiff.differentiable_iteratedDeriv {n : ℕ∞} (m : ℕ) (h : ContDiff 𝕜 n f)
    (hmn : (m : ℕ∞) < n) : Differentiable 𝕜 (iteratedDeriv m f) :=
  (contDiff_iff_iteratedDeriv.1 h).2 m hmn
#align cont_diff.differentiable_iterated_deriv ContDiff.differentiable_iteratedDeriv

/-- The `n+1`-th iterated derivative can be obtained by differentiating the `n`-th
iterated derivative. -/
theorem iteratedDeriv_succ : iteratedDeriv (n + 1) f = deriv (iteratedDeriv n f) :=
  by
  ext x
  rw [← iteratedDerivWithin_univ, ← iteratedDerivWithin_univ, ← derivWithin_univ]
  exact iteratedDerivWithin_succ uniqueDiffWithinAt_univ
#align iterated_deriv_succ iteratedDeriv_succ

/-- The `n`-th iterated derivative can be obtained by iterating `n` times the
differentiation operation. -/
theorem iteratedDeriv_eq_iterate : iteratedDeriv n f = (deriv^[n]) f :=
  by
  ext x
  rw [← iteratedDerivWithin_univ]
  convert iteratedDerivWithin_eq_iterate uniqueDiffOn_univ (mem_univ x)
  simp [derivWithin_univ]
#align iterated_deriv_eq_iterate iteratedDeriv_eq_iterate

/-- The `n+1`-th iterated derivative can be obtained by taking the `n`-th derivative of the
derivative. -/
theorem iteratedDeriv_succ' : iteratedDeriv (n + 1) f = iteratedDeriv n (deriv f) :=
  by
  rw [iteratedDeriv_eq_iterate, iteratedDeriv_eq_iterate]
  rfl
#align iterated_deriv_succ' iteratedDeriv_succ'


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri, Yury Kudryashov
-/

import geometry.manifold.cont_mdiff_map

/-!
# Diffeomorphisms
This file implements diffeomorphisms.

## Definitions

* `diffeomorph I I' M M' n`:  `n`-times continuously differentiable diffeomorphism between
  `M` and `M'` with respect to I and I'; we do not introduce a separate definition for the case
  `n = ∞`; we use notation instead.
* `diffeomorph.to_homeomorph`: reinterpret a diffeomorphism as a homeomorphism.
* `continuous_linear_equiv.to_diffeomorph`: reinterpret a continuous equivalence as
  a diffeomorphism.
* `model_with_corners.trans_diffeomorph`: compose a given `model_with_corners` with a diffeomorphism
  between the old and the new target spaces. Useful, e.g, to turn any finite dimensional manifold
  into a manifold modelled on a Euclidean space.
* `diffeomorph.to_trans_diffeomorph`: the identity diffeomorphism between `M` with model `I` and `M`
  with model `I.trans_diffeomorph e`.

## Notations

* `M ≃ₘ^n⟮I, I'⟯ M'`  := `diffeomorph I J M N n`
* `M ≃ₘ⟮I, I'⟯ M'`    := `diffeomorph I J M N ⊤`
* `E ≃ₘ^n[𝕜] E'`      := `E ≃ₘ^n⟮𝓘(𝕜, E), 𝓘(𝕜, E')⟯ E'`
* `E ≃ₘ[𝕜] E'`        := `E ≃ₘ⟮𝓘(𝕜, E), 𝓘(𝕜, E')⟯ E'`

## Implementation notes

This notion of diffeomorphism is needed although there is already a notion of structomorphism
because structomorphisms do not allow the model spaces `H` and `H'` of the two manifolds to be
different, i.e. for a structomorphism one has to impose `H = H'` which is often not the case in
practice.

## Keywords

diffeomorphism, manifold
-/

open_locale manifold topological_space
open function set

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
{G : Type*} [topological_space G]
{G' : Type*} [topological_space G']
{I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
{J : model_with_corners 𝕜 F G} {J' : model_with_corners 𝕜 F G'}

variables {M : Type*} [topological_space M] [charted_space H M]
{M' : Type*} [topological_space M'] [charted_space H' M']
{N : Type*} [topological_space N] [charted_space G N]
{N' : Type*} [topological_space N'] [charted_space G' N']
{n : with_top ℕ}

section defs

variables (I I' M M' n)

/--
`n`-times continuously differentiable diffeomorphism between `M` and `M'` with respect to I and I'
-/
@[protect_proj, nolint has_inhabited_instance]
structure diffeomorph extends M ≃ M' :=
(cont_mdiff_to_fun  : cont_mdiff I I' n to_equiv)
(cont_mdiff_inv_fun : cont_mdiff I' I n to_equiv.symm)

end defs

localized "notation M ` ≃ₘ^` n:1000 `⟮`:50 I `,` J `⟯ ` N := diffeomorph I J M N n" in manifold
localized "notation M ` ≃ₘ⟮` I `,` J `⟯ ` N := diffeomorph I J M N ⊤" in manifold
localized "notation E ` ≃ₘ^` n:1000 `[`:50 𝕜 `] ` E' :=
  diffeomorph (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') E E' n" in manifold
localized "notation E ` ≃ₘ[` 𝕜 `] ` E' :=
  diffeomorph (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') E E' ⊤" in manifold

namespace diffeomorph
instance : has_coe_to_fun (M ≃ₘ^n⟮I, I'⟯ M') (λ _, M → M') := ⟨λe, e.to_equiv⟩

instance : has_coe (M ≃ₘ^n⟮I, I'⟯ M') C^n⟮I, M; I', M'⟯ := ⟨λ Φ, ⟨Φ, Φ.cont_mdiff_to_fun⟩⟩

@[continuity] protected lemma continuous (h : M ≃ₘ^n⟮I, I'⟯ M') : continuous h :=
h.cont_mdiff_to_fun.continuous
protected lemma cont_mdiff (h : M ≃ₘ^n⟮I, I'⟯ M') : cont_mdiff I I' n h :=
h.cont_mdiff_to_fun
protected lemma cont_mdiff_at (h : M ≃ₘ^n⟮I, I'⟯ M') {x} : cont_mdiff_at I I' n h x :=
h.cont_mdiff.cont_mdiff_at
protected lemma cont_mdiff_within_at (h : M ≃ₘ^n⟮I, I'⟯ M') {s x} :
  cont_mdiff_within_at I I' n h s x :=
h.cont_mdiff_at.cont_mdiff_within_at
protected lemma cont_diff (h : E ≃ₘ^n[𝕜] E') : cont_diff 𝕜 n h :=
h.cont_mdiff.cont_diff
protected lemma smooth (h : M ≃ₘ⟮I, I'⟯ M') : smooth I I' h := h.cont_mdiff_to_fun
protected lemma mdifferentiable (h : M ≃ₘ^n⟮I, I'⟯ M') (hn : 1 ≤ n) : mdifferentiable I I' h :=
h.cont_mdiff.mdifferentiable hn
protected lemma mdifferentiable_on (h : M ≃ₘ^n⟮I, I'⟯ M') (s : set M) (hn : 1 ≤ n) :
  mdifferentiable_on I I' h s :=
(h.mdifferentiable hn).mdifferentiable_on

@[simp] lemma coe_to_equiv (h : M ≃ₘ^n⟮I, I'⟯ M') : ⇑h.to_equiv = h := rfl
@[simp, norm_cast] lemma coe_coe (h : M ≃ₘ^n⟮I, I'⟯ M') : ⇑(h : C^n⟮I, M; I', M'⟯) = h := rfl

lemma to_equiv_injective : injective (diffeomorph.to_equiv : (M ≃ₘ^n⟮I, I'⟯ M') → (M ≃ M'))
| ⟨e, _, _⟩ ⟨e', _, _⟩ rfl := rfl

@[simp] lemma to_equiv_inj {h h' : M ≃ₘ^n⟮I, I'⟯ M'} : h.to_equiv = h'.to_equiv ↔ h = h' :=
to_equiv_injective.eq_iff

/-- Coercion to function `λ h : M ≃ₘ^n⟮I, I'⟯ M', (h : M → M')` is injective. -/
lemma coe_fn_injective : injective (λ (h : M ≃ₘ^n⟮I, I'⟯ M') (x : M), h x) :=
equiv.coe_fn_injective.comp to_equiv_injective

@[ext] lemma ext {h h' : M ≃ₘ^n⟮I, I'⟯ M'} (Heq : ∀ x, h x = h' x) : h = h' :=
coe_fn_injective $ funext Heq

section

variables (M I n)

/-- Identity map as a diffeomorphism. -/
protected def refl : M ≃ₘ^n⟮I, I⟯ M :=
{ cont_mdiff_to_fun := cont_mdiff_id,
  cont_mdiff_inv_fun := cont_mdiff_id,
  to_equiv := equiv.refl M }

@[simp] lemma refl_to_equiv : (diffeomorph.refl I M n).to_equiv = equiv.refl _ := rfl
@[simp] lemma coe_refl : ⇑(diffeomorph.refl I M n) = id := rfl

end

/-- Composition of two diffeomorphisms. -/
protected def trans (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : M' ≃ₘ^n⟮I', J⟯ N) :
  M ≃ₘ^n⟮I, J⟯ N :=
{ cont_mdiff_to_fun  := h₂.cont_mdiff_to_fun.comp h₁.cont_mdiff_to_fun,
  cont_mdiff_inv_fun := h₁.cont_mdiff_inv_fun.comp h₂.cont_mdiff_inv_fun,
  to_equiv := h₁.to_equiv.trans h₂.to_equiv }

@[simp] lemma trans_refl (h : M ≃ₘ^n⟮I, I'⟯ M') : h.trans (diffeomorph.refl I' M' n) = h :=
ext $ λ _, rfl
@[simp] lemma refl_trans (h : M ≃ₘ^n⟮I, I'⟯ M') : (diffeomorph.refl I M n).trans h = h :=
ext $ λ _, rfl
@[simp] lemma coe_trans (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : M' ≃ₘ^n⟮I', J⟯ N) :
  ⇑(h₁.trans h₂) = h₂ ∘ h₁ := rfl

/-- Inverse of a diffeomorphism. -/
protected def symm (h : M ≃ₘ^n⟮I, J⟯ N) : N ≃ₘ^n⟮J, I⟯ M :=
{ cont_mdiff_to_fun  := h.cont_mdiff_inv_fun,
  cont_mdiff_inv_fun := h.cont_mdiff_to_fun,
  to_equiv := h.to_equiv.symm }

@[simp] lemma apply_symm_apply (h : M ≃ₘ^n⟮I, J⟯ N) (x : N) : h (h.symm x) = x :=
h.to_equiv.apply_symm_apply x
@[simp] lemma symm_apply_apply (h : M ≃ₘ^n⟮I, J⟯ N) (x : M) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

@[simp] lemma symm_refl : (diffeomorph.refl I M n).symm = diffeomorph.refl I M n :=
ext $ λ _, rfl
@[simp] lemma self_trans_symm (h : M ≃ₘ^n⟮I, J⟯ N) : h.trans h.symm = diffeomorph.refl I M n :=
ext h.symm_apply_apply
@[simp] lemma symm_trans_self (h : M ≃ₘ^n⟮I, J⟯ N) : h.symm.trans h = diffeomorph.refl J N n :=
ext h.apply_symm_apply
@[simp] lemma symm_trans' (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : M' ≃ₘ^n⟮I', J⟯ N) :
  (h₁.trans h₂).symm = h₂.symm.trans h₁.symm := rfl
@[simp] lemma symm_to_equiv (h : M ≃ₘ^n⟮I, J⟯ N) : h.symm.to_equiv = h.to_equiv.symm := rfl
@[simp, mfld_simps] lemma to_equiv_coe_symm (h : M ≃ₘ^n⟮I, J⟯ N) : ⇑h.to_equiv.symm = h.symm := rfl

lemma image_eq_preimage (h : M ≃ₘ^n⟮I, J⟯ N) (s : set M) : h '' s = h.symm ⁻¹' s :=
h.to_equiv.image_eq_preimage s
lemma symm_image_eq_preimage (h : M ≃ₘ^n⟮I, J⟯ N) (s : set N) : h.symm '' s = h ⁻¹' s :=
h.symm.image_eq_preimage s

@[simp, mfld_simps] lemma range_comp {α} (h : M ≃ₘ^n⟮I, J⟯ N) (f : α → M) :
  range (h ∘ f) = h.symm ⁻¹' (range f) :=
by rw [range_comp, image_eq_preimage]

@[simp] lemma image_symm_image (h : M ≃ₘ^n⟮I, J⟯ N) (s : set N) : h '' (h.symm '' s) = s :=
h.to_equiv.image_symm_image s
@[simp] lemma symm_image_image (h : M ≃ₘ^n⟮I, J⟯ N) (s : set M) : h.symm '' (h '' s) = s :=
h.to_equiv.symm_image_image s

/-- A diffeomorphism is a homeomorphism. -/
def to_homeomorph (h : M ≃ₘ^n⟮I, J⟯ N) : M ≃ₜ N :=
⟨h.to_equiv, h.continuous, h.symm.continuous⟩

@[simp] lemma to_homeomorph_to_equiv (h : M ≃ₘ^n⟮I, J⟯ N) :
  h.to_homeomorph.to_equiv = h.to_equiv :=
rfl
@[simp] lemma symm_to_homeomorph (h : M ≃ₘ^n⟮I, J⟯ N) :
  h.symm.to_homeomorph = h.to_homeomorph.symm :=
rfl

@[simp] lemma coe_to_homeomorph (h : M ≃ₘ^n⟮I, J⟯ N) : ⇑h.to_homeomorph = h := rfl
@[simp] lemma coe_to_homeomorph_symm (h : M ≃ₘ^n⟮I, J⟯ N) :
  ⇑h.to_homeomorph.symm = h.symm := rfl

@[simp] lemma cont_mdiff_within_at_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'}
  {s x} (hm : m ≤ n) :
  cont_mdiff_within_at I I' m (f ∘ h) s x ↔
    cont_mdiff_within_at J I' m f (h.symm ⁻¹' s) (h x) :=
begin
  split,
  { intro Hfh,
    rw [← h.symm_apply_apply x] at Hfh,
    simpa only [(∘), h.apply_symm_apply]
      using Hfh.comp (h x) (h.symm.cont_mdiff_within_at.of_le hm) (maps_to_preimage _ _) },
  { rw ← h.image_eq_preimage,
    exact λ hf, hf.comp x (h.cont_mdiff_within_at.of_le hm) (maps_to_image _ _) }
end

@[simp] lemma cont_mdiff_on_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'}
  {s} (hm : m ≤ n) :
  cont_mdiff_on I I' m (f ∘ h) s ↔ cont_mdiff_on J I' m f (h.symm ⁻¹' s) :=
h.to_equiv.forall_congr $ λ x, by simp only [hm, coe_to_equiv, symm_apply_apply,
  cont_mdiff_within_at_comp_diffeomorph_iff, mem_preimage]

@[simp] lemma cont_mdiff_at_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'} {x}
  (hm : m ≤ n) :
  cont_mdiff_at I I' m (f ∘ h) x ↔ cont_mdiff_at J I' m f (h x) :=
h.cont_mdiff_within_at_comp_diffeomorph_iff hm

@[simp] lemma cont_mdiff_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'}
  (hm : m ≤ n) :
  cont_mdiff I I' m (f ∘ h) ↔ cont_mdiff J I' m f :=
h.to_equiv.forall_congr $ λ x, (h.cont_mdiff_at_comp_diffeomorph_iff hm)

@[simp] lemma cont_mdiff_within_at_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) {s x} :
  cont_mdiff_within_at I' J m (h ∘ f) s x ↔ cont_mdiff_within_at I' I m f s x :=
⟨λ Hhf, by simpa only [(∘), h.symm_apply_apply]
  using (h.symm.cont_mdiff_at.of_le hm).comp_cont_mdiff_within_at _ Hhf,
  λ Hf, (h.cont_mdiff_at.of_le hm).comp_cont_mdiff_within_at _ Hf⟩

@[simp] lemma cont_mdiff_at_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) {x} :
  cont_mdiff_at I' J m (h ∘ f) x ↔ cont_mdiff_at I' I m f x :=
h.cont_mdiff_within_at_diffeomorph_comp_iff hm

@[simp] lemma cont_mdiff_on_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) {s} :
  cont_mdiff_on I' J m (h ∘ f) s ↔ cont_mdiff_on I' I m f s :=
forall₂_congr $ λ x hx, h.cont_mdiff_within_at_diffeomorph_comp_iff hm

@[simp] lemma cont_mdiff_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) :
  cont_mdiff I' J m (h ∘ f) ↔ cont_mdiff I' I m f :=
forall_congr $ λ x, h.cont_mdiff_within_at_diffeomorph_comp_iff hm

lemma to_local_homeomorph_mdifferentiable (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n) :
  h.to_homeomorph.to_local_homeomorph.mdifferentiable I J :=
⟨h.mdifferentiable_on _ hn, h.symm.mdifferentiable_on _ hn⟩

section constructions

/-- Product of two diffeomorphisms. -/
def prod_congr (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : N ≃ₘ^n⟮J, J'⟯ N') :
  M × N ≃ₘ^n⟮I.prod J, I'.prod J'⟯ M' × N' :=
{ cont_mdiff_to_fun  := (h₁.cont_mdiff.comp cont_mdiff_fst).prod_mk
    (h₂.cont_mdiff.comp cont_mdiff_snd),
  cont_mdiff_inv_fun := (h₁.symm.cont_mdiff.comp cont_mdiff_fst).prod_mk
    (h₂.symm.cont_mdiff.comp cont_mdiff_snd),
  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }

@[simp] lemma prod_congr_symm (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : N ≃ₘ^n⟮J, J'⟯ N') :
  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl

@[simp] lemma coe_prod_congr (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : N ≃ₘ^n⟮J, J'⟯ N') :
  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl

section
variables (I J J' M N N' n)

/-- `M × N` is diffeomorphic to `N × M`. -/
def prod_comm : M × N ≃ₘ^n⟮I.prod J, J.prod I⟯ N × M :=
{ cont_mdiff_to_fun  := cont_mdiff_snd.prod_mk cont_mdiff_fst,
  cont_mdiff_inv_fun := cont_mdiff_snd.prod_mk cont_mdiff_fst,
  to_equiv := equiv.prod_comm M N }

@[simp] lemma prod_comm_symm : (prod_comm I J M N n).symm = prod_comm J I N M n := rfl
@[simp] lemma coe_prod_comm : ⇑(prod_comm I J M N n) = prod.swap := rfl

/-- `(M × N) × N'` is diffeomorphic to `M × (N × N')`. -/
def prod_assoc : (M × N) × N' ≃ₘ^n⟮(I.prod J).prod J', I.prod (J.prod J')⟯ M × (N × N') :=
{ cont_mdiff_to_fun  := (cont_mdiff_fst.comp cont_mdiff_fst).prod_mk
    ((cont_mdiff_snd.comp cont_mdiff_fst).prod_mk cont_mdiff_snd),
  cont_mdiff_inv_fun := (cont_mdiff_fst.prod_mk (cont_mdiff_fst.comp cont_mdiff_snd)).prod_mk
    (cont_mdiff_snd.comp cont_mdiff_snd),
  to_equiv := equiv.prod_assoc M N N' }

end
end constructions

variables [smooth_manifold_with_corners I M] [smooth_manifold_with_corners J N]

lemma unique_mdiff_on_image_aux (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n)
  {s : set M} (hs : unique_mdiff_on I s) :
  unique_mdiff_on J (h '' s) :=
begin
  convert hs.unique_mdiff_on_preimage (h.to_local_homeomorph_mdifferentiable hn),
  simp [h.image_eq_preimage]
end

@[simp] lemma unique_mdiff_on_image (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n) {s : set M} :
  unique_mdiff_on J (h '' s) ↔ unique_mdiff_on I s :=
⟨λ hs, h.symm_image_image s ▸ h.symm.unique_mdiff_on_image_aux hn hs,
  h.unique_mdiff_on_image_aux hn⟩

@[simp] lemma unique_mdiff_on_preimage (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n) {s : set N} :
  unique_mdiff_on I (h ⁻¹' s) ↔ unique_mdiff_on J s :=
h.symm_image_eq_preimage s ▸ h.symm.unique_mdiff_on_image hn

@[simp] lemma unique_diff_on_image (h : E ≃ₘ^n[𝕜] F) (hn : 1 ≤ n) {s : set E} :
  unique_diff_on 𝕜 (h '' s) ↔ unique_diff_on 𝕜 s :=
by simp only [← unique_mdiff_on_iff_unique_diff_on, unique_mdiff_on_image, hn]

@[simp] lemma unique_diff_on_preimage (h : E ≃ₘ^n[𝕜] F) (hn : 1 ≤ n) {s : set F} :
  unique_diff_on 𝕜 (h ⁻¹' s) ↔ unique_diff_on 𝕜 s :=
h.symm_image_eq_preimage s ▸ h.symm.unique_diff_on_image hn

end diffeomorph

namespace continuous_linear_equiv

variable (e : E ≃L[𝕜] E')

/-- A continuous linear equivalence between normed spaces is a diffeomorphism. -/
def to_diffeomorph : E ≃ₘ[𝕜] E' :=
{ cont_mdiff_to_fun := e.cont_diff.cont_mdiff,
  cont_mdiff_inv_fun := e.symm.cont_diff.cont_mdiff,
  to_equiv := e.to_linear_equiv.to_equiv }

@[simp] lemma coe_to_diffeomorph : ⇑e.to_diffeomorph = e := rfl
@[simp] lemma symm_to_diffeomorph : e.symm.to_diffeomorph = e.to_diffeomorph.symm := rfl
@[simp] lemma coe_to_diffeomorph_symm : ⇑e.to_diffeomorph.symm = e.symm := rfl

end continuous_linear_equiv

namespace model_with_corners

variables (I) (e : E ≃ₘ[𝕜] E')

/-- Apply a diffeomorphism (e.g., a continuous linear equivalence) to the model vector space. -/
def trans_diffeomorph (I : model_with_corners 𝕜 E H) (e : E ≃ₘ[𝕜] E') :
  model_with_corners 𝕜 E' H :=
{ to_local_equiv := I.to_local_equiv.trans e.to_equiv.to_local_equiv,
  source_eq := by simp,
  unique_diff' := by simp [range_comp e, I.unique_diff],
  continuous_to_fun := e.continuous.comp I.continuous,
  continuous_inv_fun := I.continuous_symm.comp e.symm.continuous }

@[simp, mfld_simps] lemma coe_trans_diffeomorph : ⇑(I.trans_diffeomorph e) = e ∘ I := rfl
@[simp, mfld_simps] lemma coe_trans_diffeomorph_symm :
  ⇑(I.trans_diffeomorph e).symm = I.symm ∘ e.symm := rfl

lemma trans_diffeomorph_range : range (I.trans_diffeomorph e) = e '' (range I) :=
range_comp e I

lemma coe_ext_chart_at_trans_diffeomorph (x : M) :
  ⇑(ext_chart_at (I.trans_diffeomorph e) x) = e ∘ ext_chart_at I x := rfl

lemma coe_ext_chart_at_trans_diffeomorph_symm (x : M) :
  ⇑(ext_chart_at (I.trans_diffeomorph e) x).symm = (ext_chart_at I x).symm ∘ e.symm := rfl

lemma ext_chart_at_trans_diffeomorph_target (x : M) :
  (ext_chart_at (I.trans_diffeomorph e) x).target = e.symm ⁻¹' (ext_chart_at I x).target :=
by simp only [range_comp e, e.image_eq_preimage, preimage_preimage] with mfld_simps

end model_with_corners

namespace diffeomorph

variables (e : E ≃ₘ[𝕜] F)

instance smooth_manifold_with_corners_trans_diffeomorph [smooth_manifold_with_corners I M] :
  smooth_manifold_with_corners (I.trans_diffeomorph e) M :=
begin
  refine smooth_manifold_with_corners_of_cont_diff_on  _ _ (λ e₁ e₂ h₁ h₂, _),
  refine e.cont_diff.comp_cont_diff_on
    (((cont_diff_groupoid ⊤ I).compatible h₁ h₂).1.comp
      e.symm.cont_diff.cont_diff_on _),
  mfld_set_tac
end

variables (I M)

/-- The identity diffeomorphism between a manifold with model `I` and the same manifold
with model `I.trans_diffeomorph e`. -/
def to_trans_diffeomorph (e : E ≃ₘ[𝕜] F) : M ≃ₘ⟮I, I.trans_diffeomorph e⟯ M :=
{ to_equiv := equiv.refl M,
  cont_mdiff_to_fun := λ x,
    begin
      refine cont_mdiff_within_at_iff.2 ⟨continuous_within_at_id, _⟩,
      refine e.cont_diff.cont_diff_within_at.congr' (λ y hy, _) _,
      { simp only [equiv.coe_refl, id, (∘), I.coe_ext_chart_at_trans_diffeomorph,
          (ext_chart_at I x).right_inv hy.1] },
      exact ⟨(ext_chart_at I x).map_source (mem_ext_chart_source I x), trivial,
        by simp only with mfld_simps⟩
    end,
  cont_mdiff_inv_fun := λ x,
    begin
      refine cont_mdiff_within_at_iff.2 ⟨continuous_within_at_id, _⟩,
      refine e.symm.cont_diff.cont_diff_within_at.congr' (λ y hy, _) _,
      { simp only [mem_inter_eq, I.ext_chart_at_trans_diffeomorph_target] at hy,
        simp only [equiv.coe_refl, equiv.refl_symm, id, (∘),
          I.coe_ext_chart_at_trans_diffeomorph_symm, (ext_chart_at I x).right_inv hy.1] },
      exact ⟨(ext_chart_at _ x).map_source (mem_ext_chart_source _ x), trivial,
        by simp only [e.symm_apply_apply, equiv.refl_symm, equiv.coe_refl] with mfld_simps⟩
    end }

variables {I M}

@[simp] lemma cont_mdiff_within_at_trans_diffeomorph_right {f : M' → M} {x s} :
  cont_mdiff_within_at I' (I.trans_diffeomorph e) n f s x ↔
    cont_mdiff_within_at I' I n f s x :=
(to_trans_diffeomorph I M e).cont_mdiff_within_at_diffeomorph_comp_iff le_top

@[simp] lemma cont_mdiff_at_trans_diffeomorph_right {f : M' → M} {x} :
  cont_mdiff_at I' (I.trans_diffeomorph e) n f x ↔ cont_mdiff_at I' I n f x :=
(to_trans_diffeomorph I M e).cont_mdiff_at_diffeomorph_comp_iff le_top

@[simp] lemma cont_mdiff_on_trans_diffeomorph_right {f : M' → M} {s} :
  cont_mdiff_on I' (I.trans_diffeomorph e) n f s ↔ cont_mdiff_on I' I n f s :=
(to_trans_diffeomorph I M e).cont_mdiff_on_diffeomorph_comp_iff le_top

@[simp] lemma cont_mdiff_trans_diffeomorph_right {f : M' → M} :
  cont_mdiff I' (I.trans_diffeomorph e) n f ↔ cont_mdiff I' I n f :=
(to_trans_diffeomorph I M e).cont_mdiff_diffeomorph_comp_iff le_top

@[simp] lemma smooth_trans_diffeomorph_right {f : M' → M} :
  smooth I' (I.trans_diffeomorph e) f ↔ smooth I' I f :=
cont_mdiff_trans_diffeomorph_right e

@[simp]

@[simp] lemma cont_mdiff_at_trans_diffeomorph_left {f : M → M'} {x} :
  cont_mdiff_at (I.trans_diffeomorph e) I' n f x ↔ cont_mdiff_at I I' n f x :=
((to_trans_diffeomorph I M e).cont_mdiff_at_comp_diffeomorph_iff le_top).symm

@[simp] lemma cont_mdiff_on_trans_diffeomorph_left {f : M → M'} {s} :
  cont_mdiff_on (I.trans_diffeomorph e) I' n f s ↔ cont_mdiff_on I I' n f s :=
((to_trans_diffeomorph I M e).cont_mdiff_on_comp_diffeomorph_iff le_top).symm

@[simp] lemma cont_mdiff_trans_diffeomorph_left {f : M → M'} :
  cont_mdiff (I.trans_diffeomorph e) I' n f ↔ cont_mdiff I I' n f :=
((to_trans_diffeomorph I M e).cont_mdiff_comp_diffeomorph_iff le_top).symm

@[simp] lemma smooth_trans_diffeomorph_left {f : M → M'} :
  smooth (I.trans_diffeomorph e) I' f ↔ smooth I I' f :=
e.cont_mdiff_trans_diffeomorph_left

end diffeomorph


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn

Defines natural transformations between functors.

Introduces notations
  `τ.app X` for the components of natural transformations,
  `F ⟶ G` for the type of natural transformations between functors `F` and `G`,
  `σ ≫ τ` for vertical compositions, and
  `σ ◫ τ` for horizontal compositions.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l

namespace Mathlib

namespace category_theory

/--
`nat_trans F G` represents a natural transformation between functors `F` and `G`.

The field `app` provides the components of the natural transformation.

Naturality is expressed by `α.naturality_lemma`.
-/
structure nat_trans {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (G : C ⥤ D)
where
  app : (X : C) → functor.obj F X ⟶ functor.obj G X
  naturality' : autoParam (∀ {X Y : C} (f : X ⟶ Y), functor.map F f ≫ app Y = app X ≫ functor.map G f)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- Rather arbitrarily, we say that the 'simpler' form is

@[simp] theorem nat_trans.naturality {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} (c : nat_trans F G) {X : C} {Y : C} (f : X ⟶ Y) : functor.map F f ≫ nat_trans.app c Y = nat_trans.app c X ≫ functor.map G f := sorry

-- components of natural transfomations moving earlier.

@[simp] theorem nat_trans.naturality_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} (c : nat_trans F G) {X : C} {Y : C} (f : X ⟶ Y) {X' : D} (f' : functor.obj G Y ⟶ X') : functor.map F f ≫ nat_trans.app c Y ≫ f' = nat_trans.app c X ≫ functor.map G f ≫ f' := sorry

theorem congr_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {α : nat_trans F G} {β : nat_trans F G} (h : α = β) (X : C) : nat_trans.app α X = nat_trans.app β X :=
  congr_fun (congr_arg nat_trans.app h) X

namespace nat_trans

/-- `nat_trans.id F` is the identity natural transformation on a functor `F`. -/
protected def id {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) : nat_trans F F :=
  mk fun (X : C) => 𝟙

@[simp] theorem id_app' {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (X : C) : app (nat_trans.id F) X = 𝟙 :=
  rfl

protected instance inhabited {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) : Inhabited (nat_trans F F) :=
  { default := nat_trans.id F }

/-- `vcomp α β` is the vertical compositions of natural transformations. -/
def vcomp {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} (α : nat_trans F G) (β : nat_trans G H) : nat_trans F H :=
  mk fun (X : C) => app α X ≫ app β X

-- functor_category will rewrite (vcomp α β) to (α ≫ β), so this is not a

-- suitable simp lemma.  We will declare the variant vcomp_app' there.

theorem vcomp_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} (α : nat_trans F G) (β : nat_trans G H) (X : C) : app (vcomp α β) X = app α X ≫ app β X :=
  rfl


import homotopy_group.basic
import homotopy.equiv

/-!
# Homotopy equivalences induce group isomorphisms

In this file, we show that given `h : homotopy_equiv X Y`, then we have a group isomorphism
`π₁ x₀ ≃* π₁ (h x₀)`.
-/

noncomputable theory

variables {X Y : Type _} [topological_space X] [topological_space Y] {x₀ : X} {f g : C(X, Y)}

/--
Given a homotopy between `f` and `g`, we have a path between `f x₀` and `g x₀` given by the
homotopy.
-/
def homotopy.path (h : homotopy f g) : path' (f x₀) (g x₀) :=
{ to_fun :=
  { to_fun := λ r, h (x₀, r) },
  to_fun_zero' := by norm_num,
  to_fun_one' := by norm_num } .

lemma mul_equiv.symm_to_monoid_hom_comp_to_monoid_hom {M N : Type _} [monoid M] [monoid N]
  (h : M ≃* N) : h.symm.to_monoid_hom.comp h.to_monoid_hom = monoid_hom.id _ :=
begin
  ext,
  unfold mul_equiv.symm equiv.symm,
  simp,
end

namespace π₁

private def F (l : loop x₀) (h : homotopy f g) : C(ℝ × ℝ, Y) :=
{ to_fun := λ p, h (l p.1, p.2) }

private def l₁ : path' ((0, 1) : ℝ × ℝ) (1, 1) :=
{ to_fun := { to_fun := λ s, (s, 1) },
  to_fun_zero' := by simp,
  to_fun_one' := by simp } .

private def l₂₁ : path' ((0, 1) : ℝ × ℝ) (0, 0) :=
{ to_fun := { to_fun := λ s, (0, 1 - s) },
  to_fun_zero' := by simp,
  to_fun_one' := by simp } .

private def l₂₂ : path' ((0, 0) : ℝ × ℝ) (1, 0) :=
{ to_fun := { to_fun := λ s, (s, 0) },
  to_fun_zero' := by simp,
  to_fun_one' := by simp } .

private def l₂₃ : path' ((1, 0) : ℝ × ℝ) (1, 1) :=
{ to_fun := { to_fun := λ s, (1, s) },
  to_fun_zero' := by simp,
  to_fun_one' := by simp } .

private def l₂ := (l₂₁.trans l₂₂).trans l₂₃

private def homotopy_l₁_l₂ : path_homotopy l₁ l₂ :=
{ to_fun := { to_fun := λ p, (1 - p.2) • l₁ p.1 + p.2 • l₂ p.1 },
  to_fun_zero' := by norm_num,
  to_fun_one' := by norm_num,
  prop := λ t, by norm_num } .

private def l₁_map (l : loop x₀) (h : homotopy f g) : (l₁.map (F l h) : ℝ → Y) = (l.map g) :=
begin
  ext t,
  simp only [F, l₁, path'.map, path'.coe_apply, homotopy_with.to_fun_one, path'.mk_apply,
             continuous_map.comp_coe, continuous_map.coe_mk, function.comp_app],
end

private def l₂_map (l : loop x₀) (h : homotopy f g) :
  (l₂.map (F l h) : ℝ → Y) = ((h.path.inv.trans (l.map f)).trans h.path) :=
begin
  ext t,
  simp only [path'.coe_apply, path'.mk_apply, continuous_map.comp_coe, F, continuous_map.coe_mk,
             l₂, path'.map, function.comp_app, path'.trans],
  split_ifs with h₁ h₂,
  { simp [homotopy.path, l₂₁, path'.inv] },
  { simp [homotopy.path, l₂₂, path'.inv] },
  { simp [homotopy.path, l₂₃, path'.inv] },
end .

private def change_of_basepoint_comp_map_eq_map_aux (l : loop x₀) (h : homotopy f g) :=
  path_homotopy.change_end_points (homotopy_l₁_l₂.map _) (l₁_map l h) (l₂_map l h)

private lemma change_of_basepoint_comp_map_eq_map (h : homotopy f g) :
  (π₁.change_of_basepoint h.path : π₁ (f x₀) ≃* π₁ (g x₀)).to_monoid_hom.comp (π₁.map f)
    = π₁.map g :=
begin
  ext x,
  apply quotient.induction_on x,
  intro l,
  simp only [π₁.change_of_basepoint, π₁.map, mul_equiv.coe_to_monoid_hom, quotient.lift_mk,
    mul_equiv.coe_mk, function.comp_app, monoid_hom.coe_mk, monoid_hom.coe_comp, quotient.eq],
  exact ⟨(change_of_basepoint_comp_map_eq_map_aux l h).symm⟩,
end .

private lemma bij_helper₁ {x₀ : X} (h : homotopy_equiv X Y) :
  (π₁.map (h.symm : C(Y, X))).comp (π₁.map (h : C(X, Y)) : π₁ x₀ →* _) =
    (@π₁.change_of_basepoint _ _ x₀ _ (homotopy.path h.left_inv.some.symm)).to_monoid_hom :=
calc (π₁.map h.inv_fun).comp (π₁.map h.to_fun : π₁ x₀ →* _) =
  (@π₁.change_of_basepoint _ _ x₀ _ (homotopy.path h.left_inv.some.symm)).to_monoid_hom.comp
    (π₁.map continuous_map.id) : by rw [change_of_basepoint_comp_map_eq_map, π₁.map_comp]
                       ... = _ : by { ext, simp } .

private def u (h : homotopy_equiv X Y) : path' (h x₀) (h (h.symm (h x₀))) :=
  homotopy.path (h.right_inv.some.symm)

private lemma bij_helper₂ {x₀ : X} (h : homotopy_equiv X Y) :
  (@π₁.change_of_basepoint _ _ (h x₀) _ (u h)).to_monoid_hom =
    (π₁.map (h : C(X, Y))).comp (π₁.map (h.symm : C(Y, X)) : π₁ _ →* _) :=
calc (@π₁.change_of_basepoint _ _ (h.to_fun x₀) _ (u h)).to_monoid_hom =
  (@π₁.change_of_basepoint _ _ (h.to_fun x₀) _ (u h)).to_monoid_hom.comp
    (π₁.map continuous_map.id) : by { ext, simp }
  ... = (π₁.map h.to_fun).comp (π₁.map h.inv_fun : π₁ _ →* _) :
    by { rw [u, change_of_basepoint_comp_map_eq_map, π₁.map_comp] } .

/--
Given `h : homotopy_equiv X Y`, we have an induced group isomorphism.
-/
def map_homotopy {Y : Type _} [topological_space Y] (h : homotopy_equiv X Y) :
  π₁ x₀ ≃* π₁ (h.to_fun x₀) :=
  mul_equiv.of_bijective (π₁.map h.to_fun)
begin
  have hyp : function.bijective (π₁.map h.inv_fun : π₁ (h.to_fun x₀) →* _),
  { split,
    { have : function.injective (@π₁.change_of_basepoint _ _ (h.to_fun x₀) _ (u h)).to_monoid_hom,
      { exact mul_equiv.injective _ },
      rw [bij_helper₂, monoid_hom.coe_comp] at this,
      exact function.injective.of_comp this },
    { have : function.surjective
        (@π₁.change_of_basepoint _ _ x₀ _ (homotopy.path h.left_inv.some.symm)).to_monoid_hom,
      { exact mul_equiv.surjective _ },
      rw [←bij_helper₁, monoid_hom.coe_comp] at this,
      exact function.surjective.of_comp this } },
  set r := mul_equiv.of_bijective _ hyp with hr,
  have hyp₂ : π₁.map h.to_fun = r.symm.to_monoid_hom.comp (r.to_monoid_hom.comp (π₁.map h.to_fun)),
  { rw [←monoid_hom.comp_assoc, mul_equiv.symm_to_monoid_hom_comp_to_monoid_hom,
        monoid_hom.id_comp] },
  rw [hyp₂, monoid_hom.coe_comp],
  apply function.bijective.comp,
  { exact mul_equiv.bijective _ },
  { have : function.bijective
        (@π₁.change_of_basepoint _ _ x₀ _ (homotopy.path h.left_inv.some.symm)).to_monoid_hom,
      { exact mul_equiv.bijective _ },
    convert this,
    rw [hr, ←bij_helper₁],
    refl }
end

lemma map_homotopy_to_monoid_hom {Y : Type _} [topological_space Y] (h : homotopy_equiv X Y) :
  (map_homotopy h).to_monoid_hom = @map _ _ x₀ _ _ (h : C(X, Y)) := rfl

end π₁


lemma pow_one (a : mynat) : a ^ (1 : mynat) = a :=
begin
rw one_eq_succ_zero,
rw pow_succ,
rw pow_zero,
rwa one_mul,
end


import SciLean.Quot.FreeMonoid
import SciLean.Quot.QuotQ

inductive List.Sorted {X : Type u} [LT X] : List X → Prop where
| empty : Sorted []
| singl (x : X) : Sorted [x]
| head  (x y : X) (ys : List X) (h : (x < y) ∨ (x = y)) (h' : Sorted (y :: ys))
        : Sorted (x :: y :: ys)

inductive List.StrictlySorted {X : Type u} [LT X] : List X → Prop where
| empty : StrictlySorted []
| singl (x : X) : StrictlySorted [x]
| head  (x y : X) (ys : List X) (h : x < y)
        (h' : StrictlySorted (y :: ys))
        : StrictlySorted (x :: y :: ys)

--- Sorts list and returns the number of transpositions, bool indicates repeated element
partial def List.bubblesortTransNum {α} [LT α] [DecidableCp α] (l : List α) : List α × ℕ × Bool :=
  match l with
  | [] => ([], 0, false)
  | x :: xs =>
    match xs.bubblesortTransNum with
    | ([], n, b) => ([x], n, b)
    | (y :: ys, n, b) =>
      match decCp x y with
      | cpEq h => (x :: y :: ys, n, true)
      | cpLt h => (x :: y :: ys, n, b)
      | cpGt h =>
        let (xys, n', b') := (x :: ys).bubblesortTransNum
        (y :: xys, n + n' + 1, b ∨ b')

def List.bubblesort {α} [LT α] [DecidableCp α] (l : List α) : List α
  := l.bubblesortTransNum.1

namespace SciLean

open Quot'

class Rank (α : Type u) where
  rank : α → ℕ

def napply (f : α → α) (n : ℕ) (a : α) : α :=
  match n with
  | 0 => a
  | n+1 => napply f n (f a)

export Rank (rank)

class Monomial (M) (K : Type v) (X : Type u) extends HMul K M M, Mul M where
  intro : K → X → M
  base : M → X
  coef : M → K

namespace Monomial

  structure Repr (K : Type v) (ι : Type u) where
    coef : K
    base : FreeMonoid ι

  instance {K ι} [ToString K] [ToString ι] : ToString (Repr K ι) :=
   ⟨λ x => s!"{x.coef}*{x.base}"⟩

  instance {K ι} [Mul K] : Mul (Repr K ι) :=
    ⟨λ x y => ⟨x.coef * y.coef, x.base * y.base⟩⟩

  instance {K ι} [Mul K] : HMul K (Repr K ι) (Repr K ι) :=
    ⟨λ a x => ⟨a * x.coef, x.base⟩⟩
  instance {K ι} [Mul K] : HMul (Repr K ι) K (Repr K ι) :=
    ⟨λ x a => ⟨x.coef * a, x.base⟩⟩

  -- def Repr.rank {K X} (x : Repr K X) : Nat := x.base.rank

  -- Makes only multiplication on X
  inductive FreeEq (K ι) [Zero K] : Repr K ι → Repr K ι → Prop where
    | refl (x : Repr K ι) : FreeEq K ι x x
    | zero_coeff (x y : FreeMonoid ι) : FreeEq K ι ⟨0, x⟩ ⟨0, y⟩

  inductive SymEq (K ι) [Zero K] : Repr K ι → Repr K ι → Prop where
    | eq (x y : Repr K ι) (h : FreeEq K ι x y) : SymEq K ι x y
    | sym_mul (c : K) (x y : FreeMonoid ι) : SymEq K ι ⟨c, x * y⟩ ⟨c, y * x⟩

  inductive AltEq (K ι) [Zero K] [Neg K] : Repr K ι → Repr K ι → Prop where
    | eq (x y : Repr K ι) (h : FreeEq K ι x y) : AltEq K ι x y
    | alt_mul (c : K) (x y : FreeMonoid ι) : AltEq K ι ⟨c, x * y⟩ ⟨napply Neg.neg (x.rank * y.rank) c, y * x⟩

  instance {K ι} [Zero K] : QForm (FreeEq K ι) :=
  {
    RedForm := λ lvl x =>
      match lvl with
      | redLvl n => True
      | normLvl => (x.coef = 0 → x.base = 1)
    redform_norm := sorry
    redform_zero := sorry
    redform_succ := sorry
    redform_inf  := sorry
  }

  instance {K ι} [LT ι] [Zero K] : QForm (SymEq K ι) :=
  {
    RedForm := λ lvl x =>
      match lvl with
      | redLvl 0 => True
      | redLvl n => x.base.1.Sorted
      | normLvl => x.base.1.Sorted ∧ (x.coef = 0 → x.base = 1)
    redform_norm := sorry
    redform_zero := sorry
    redform_succ := sorry
    redform_inf  := sorry
  }

  instance {K ι} [LT ι] [Zero K] [Neg K] : QForm (AltEq K ι) :=
  {
    RedForm := λ lvl x =>
      match lvl with
      | redLvl 0 => True
      | redLvl n => x.base.1.StrictlySorted
      | normLvl => x.base.1.StrictlySorted ∧ (x.coef = 0 → x.base = 1)
    redform_norm := sorry
    redform_zero := sorry
    redform_succ := sorry
    redform_inf  := sorry
  }

  instance {K ι} [Zero K] : QReduce (FreeEq K ι) rawLvl :=
  {
    reduce := λ x => x
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [Zero K] [DecidableEq K] : QReduce (FreeEq K ι) normLvl :=
  {
    reduce := λ x => if x.coef = 0 then ⟨0, 1⟩ else x
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [LT ι] [Zero K] : QReduce (SymEq K ι) rawLvl :=
  {
    reduce := λ x => x
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [LT ι] [DecidableCp ι] [Zero K] : QReduce (SymEq K ι) (redLvl 1) :=
  {
    reduce := λ x => ⟨x.coef, ⟨x.base.1.bubblesort⟩⟩
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [LT ι] [DecidableCp ι] [Zero K] [DecidableEq K] : QReduce (SymEq K ι) normLvl :=
  {
    reduce := λ x => if x.coef = 0 then ⟨0, 1⟩ else (QReduce.reduce (SymEq K ι) (redLvl 1) x)
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [LT ι] [Zero K] [Neg K] : QReduce (AltEq K ι) rawLvl :=
  {
    reduce := λ x => x
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [LT ι] [DecidableCp ι] [Zero K] [Neg K] : QReduce (AltEq K ι) (redLvl 1) :=
  {
    reduce := λ x =>
      let (xb, n, b) := x.base.1.bubblesortTransNum
      if b then
        ⟨0, 1⟩
      else
        let c := if n%2==0 then x.coef else -x.coef
        ⟨c, ⟨xb⟩⟩
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

  instance {K ι} [LT ι] [DecidableCp ι] [Zero K] [Neg K] [DecidableEq K] : QReduce (AltEq K ι) normLvl :=
  {
    reduce := λ x => if x.coef = 0 then ⟨0, 1⟩ else (QReduce.reduce (AltEq K ι) (redLvl 1) x)
    is_reduce := sorry
    eq_reduce := sorry
    preserve_stronger := sorry
  }

end Monomial

def FreeMonomial (K : Type v) (ι : Type u) [Zero K] :=
  Quot' (Monomial.FreeEq K ι)

def SymMonomial (K : Type v) (ι : Type u) [LT ι] [Zero K] :=
  Quot' (Monomial.SymEq K ι)

def AltMonomial (K : Type v) (ι : Type u) [LT ι] [Neg K] [Zero K]:=
  Quot' (Monomial.AltEq K ι)

namespace FreeMonomial
  open Monomial

  variable {K ι} [Zero K] [One K] [Mul K] [DecidableEq K] -- [Reduce K] [Normalize K]  --[QNormalize (FreeEq K X)]

  instance (c : K) : IsQHom (FreeEq K ι) (FreeEq K ι) (λ x => ⟨c*x.coef, x.base⟩) := sorry
  instance (n : Nat) (c : K) : IsQHom' (redLvl n) (FreeEq K ι) (λ x => ⟨c*x.coef, x.base⟩) := sorry
  instance {n : Nat} : HMul K (FreeMonomial K ι) (FreeMonomial K ι) :=
    ⟨λ c m => Quot'.lift' (redLvl n) (λ x => ⟨c*x.coef, x.base⟩) m⟩

  instance : IsQHom₂ (FreeEq K ι) (FreeEq K ι) (FreeEq K ι)
    (λ x y => ⟨x.coef*y.coef, x.base*y.base⟩) := sorry
  instance : Mul (FreeMonomial K ι) :=
  ⟨Quot'.lift₂ (λ x y => ⟨x.coef*y.coef, x.base*y.base⟩)⟩

  instance (c : K) : IsQHom (FreeEq K ι) (FreeEq K ι) (λ x => c * x) := sorry
  instance {n} (c : K) : IsQHom' (redLvl n) (FreeEq K ι) (λ x => c * x) := sorry
  instance : HMul K (FreeMonomial K ι) (FreeMonomial K ι) :=
  ⟨λ c => Quot'.lift' (redLvl 0) (λ x => c * x)⟩

  instance : Zero (FreeMonomial K ι) := ⟨⟦⟨⟨0, 1⟩, normLvl, sorry⟩⟧⟩
  instance : One (FreeMonomial K ι) := ⟨⟦⟨⟨1, 1⟩, normLvl, sorry⟩⟧⟩

  instance : Monomial (FreeMonomial K ι) K (FreeMonoid ι) :=
  {
    intro := λ k x => ⟦⟨⟨k, x⟩, rawLvl, sorry⟩⟧
    base := λ m => m.nrepr.base
    coef := λ m => m.nrepr.coef
  }

  instance : Semigroup (FreeMonomial K ι) :=
  {
    mul_assoc := sorry
  }

  instance : Monoid (FreeMonomial K ι) :=
  {
    mul_one := sorry
    one_mul := sorry
    npow_zero' := sorry
    npow_succ' := sorry
  }

  instance : MonoidWithZero (FreeMonomial K ι) :=
  {
    zero_mul := sorry
    mul_zero := sorry
  }

  def toString [ToString ι] [ToString K]
    (mul smul : String) (m : FreeMonomial K ι) : String
    :=
  Id.run do
    let m' := m.nrepr
    let mut s := s!"{m'.coef}{smul}{m'.base.toString mul}"
    s

  instance [ToString ι] [ToString K] : ToString (FreeMonomial K ι)
    := ⟨λ m => m.toString "⊗" "*"⟩

  instance {lvl} [QReduce (FreeEq K ι) lvl] : Reduce (FreeMonomial K ι) lvl := Quot'.instReduceQuot'

end FreeMonomial

namespace SymMonomial
  open Monomial

  variable {K ι} [LT ι] [DecidableCp ι] [DecidableEq K] [Zero K] [One K] [Mul K] --[Reduce K] [Normalize K] -- [QNormalize (SymEq K ι)]

  instance (c : K) : IsQHom (SymEq K ι) (SymEq K ι) (λ x => ⟨c*x.coef, x.base⟩) := sorry
  instance {n} (c : K) : IsQHom' (redLvl n) (SymEq K ι) (λ x => ⟨c*x.coef, x.base⟩) := sorry
  instance : HMul K (SymMonomial K ι) (SymMonomial K ι) :=
  ⟨λ c => Quot'.lift' (redLvl 1) (λ x => ⟨c*x.coef, x.base⟩)⟩

  instance : IsQHom₂ (SymEq K ι) (SymEq K ι) (SymEq K ι)
    (λ x y => ⟨x.coef*y.coef, x.base*y.base⟩) := sorry
  instance : Mul (SymMonomial K ι) :=
  ⟨Quot'.lift₂ (λ x y => ⟨x.coef*y.coef, x.base*y.base⟩)⟩

  instance : Zero (SymMonomial K ι) := ⟨⟦⟨⟨0, 1⟩, normLvl, sorry⟩⟧⟩
  instance : One (SymMonomial K ι) := ⟨⟦⟨⟨1, 1⟩, normLvl, sorry⟩⟧⟩

  instance : Monomial (SymMonomial K ι) K (FreeMonoid ι) :=
  {
    intro := λ k x => ⟦⟨⟨k, x⟩, rawLvl, sorry⟩⟧
    base := λ m => m.nrepr.base
    coef := λ m => m.nrepr.coef
  }

  instance : Semigroup (SymMonomial K ι) :=
  {
    mul_assoc := sorry
  }

  instance : Monoid (SymMonomial K ι) :=
  {
    mul_one := sorry
    one_mul := sorry
    npow_zero' := sorry
    npow_succ' := sorry
  }

  instance : MonoidWithZero (SymMonomial K ι) :=
  {
    zero_mul := sorry
    mul_zero := sorry
  }

  instance : DecidableEq (SymMonomial K ι) :=
  λ x y => if ((Monomial.coef (FreeMonoid ι) x : K) = (Monomial.coef (FreeMonoid ι) y : K)) ∧
              ((base K x : (FreeMonoid ι)) = (base K y : (FreeMonoid ι)))
           then isTrue sorry
           else isFalse sorry

  def toString [ToString ι] [ToString K]
    (mul smul : String) (m : SymMonomial K ι) : String
    :=
  Id.run do
    let m' := m.nrepr
    if m'.coef = 1 then
      s!"{m'.base.toString mul}"
    else
      s!"{m'.coef}{smul}{m'.base.toString mul}"

  instance [ToString ι] [ToString K] : ToString (SymMonomial K ι)
    := ⟨λ m => m.toString "*" "*"⟩

  instance {lvl} [QReduce (SymEq K ι) lvl] : Reduce (SymMonomial K ι) lvl := Quot'.instReduceQuot'

end SymMonomial

namespace AltMonomial
  open Monomial

  variable {K ι} [LT ι] [DecidableCp ι] [Zero K] [One K] [Neg K] [Mul K] [Normalize K] [DecidableEq K] -- [QNormalize (AltEq K ι)]

  instance (c : K) : IsQHom (AltEq K ι) (AltEq K ι) (λ x => ⟨c*x.coef, x.base⟩) := sorry
  instance (n : Nat) (c : K) : IsQHom' (redLvl n) (AltEq K ι) (λ x => ⟨c*x.coef, x.base⟩) := sorry
  instance : HMul K (AltMonomial K ι) (AltMonomial K ι) :=
  ⟨
    λ c m => Quot'.lift' (redLvl 1) (λ x => ⟨c*x.coef, x.base⟩) m
  ⟩

  instance : IsQHom₂ (AltEq K ι) (AltEq K ι) (AltEq K ι)
    (λ x y => ⟨x.coef*y.coef, x.base*y.base⟩) := sorry
  instance : Mul (AltMonomial K ι) :=
  ⟨Quot'.lift₂ (λ x y => ⟨x.coef*y.coef, x.base*y.base⟩)⟩

  instance : Zero (AltMonomial K ι) := ⟨⟦⟨⟨0, 1⟩, normLvl, sorry⟩⟧⟩
  instance : One (AltMonomial K ι) := ⟨⟦⟨⟨1, 1⟩, normLvl, sorry⟩⟧⟩

  instance : Monomial (AltMonomial K ι) K (FreeMonoid ι) :=
  {
    intro := λ k x => ⟦⟨⟨k, x⟩, rawLvl, sorry⟩⟧
    base := λ m => m.nrepr.base
    coef := λ m => m.nrepr.coef
  }

  instance : Semigroup (AltMonomial K ι) :=
  {
    mul_assoc := sorry
  }

  instance : Monoid (AltMonomial K ι) :=
  {
    mul_one := sorry
    one_mul := sorry
    npow_zero' := sorry
    npow_succ' := sorry
  }

  instance : MonoidWithZero (AltMonomial K ι) :=
  {
    zero_mul := sorry
    mul_zero := sorry
  }

  def toString [ToString ι] [ToString K]
    (mul smul : String) (m : AltMonomial K ι) : String
    :=
  Id.run do
    let m' := m.nrepr
    let mut s := s!"{m'.coef}{smul}{m'.base.toString mul}"
    s

  instance [ToString ι] [ToString K] : ToString (AltMonomial K ι)
    := ⟨λ m => m.toString "∧" "*"⟩

  instance [ToString K] : ToString (AltMonomial K Nat)
    := ⟨λ m => m.toString "∧" "*"⟩

  instance instReduce (lvl) [QReduce (AltEq K ι) lvl] : Reduce (AltMonomial K ι) lvl := Quot'.instReduceQuot'
  instance [QNormalize (AltEq K ι)] : Normalize (AltMonomial K ι) := instReduce normLvl

end AltMonomial

def m : FreeMonomial Int Nat := ⟦⟨⟨1, ⟨[0,2,0,3]⟩⟩, rawLvl, sorry⟩⟧
def p : SymMonomial Int Nat := ⟦⟨⟨2, ⟨[0,2,0,3]⟩⟩, rawLvl, sorry⟩⟧
def w : AltMonomial Int Nat := ⟦⟨⟨2, ⟨[1,0,3]⟩⟩, rawLvl, sorry⟩⟧
def w' : AltMonomial Int Nat := ⟦⟨⟨0, ⟨[5,2]⟩⟩, rawLvl, sorry⟩⟧
def w'' : AltMonomial Int Nat := ⟦⟨⟨3, ⟨[5,2]⟩⟩, rawLvl, sorry⟩⟧

example : (m |> toString) = "1*[0]⊗[2]⊗[0]⊗[3]" := by native_decide
example : (p*p |>.toDebugString) = "⟦4*[0]⊗[2]⊗[0]⊗[3]⊗[0]⊗[2]⊗[0]⊗[3]⟧₀" := by native_decide
example : (p*p |> reduce (redLvl 1) |>.toDebugString) = "⟦4*[0]⊗[0]⊗[0]⊗[0]⊗[2]⊗[2]⊗[3]⊗[3]⟧₁" := by native_decide
example : (p |> toString) = "2*[0]*[0]*[2]*[3]" := by native_decide

example : (w |> toString) = "-2*[0]∧[1]∧[3]" := by native_decide
example : (w |> reduce (redLvl 0) |>.toDebugString) = "⟦2*[1]⊗[0]⊗[3]⟧₀" := by native_decide
example : (w |> reduce (redLvl 1) |>.toDebugString) = "⟦-2*[0]⊗[1]⊗[3]⟧₁" := by native_decide
example : (w |> normalize |>.toDebugString) = "⟦-2*[0]⊗[1]⊗[3]⟧∞" := by native_decide
example : (w*w |> reduce (redLvl 1) |>.toDebugString) = "⟦0*1⟧₁" := by native_decide
example : (w*w'' |> reduce (redLvl 1) |>.toDebugString) = "⟦-6*[0]⊗[1]⊗[2]⊗[3]⊗[5]⟧₁" := by native_decide

example : (w' |> toString) = "0*1" := by native_decide
example : (w' |>.toDebugString) = "⟦0*[5]⊗[2]⟧₀" := by native_decide
example : (w' |> reduce (redLvl 1) |>.toDebugString) = "⟦0*[2]⊗[5]⟧₁" := by native_decide
example : (w' |> normalize |>.toDebugString) = "⟦0*1⟧∞" := by native_decide

example : (w*w' |>.toDebugString) = "⟦0*[1]⊗[0]⊗[3]⊗[5]⊗[2]⟧₀" := by native_decide
example : (w*w' |> reduce (redLvl 1) |>.toDebugString) = "⟦0*[0]⊗[1]⊗[2]⊗[3]⊗[5]⟧₁" := by native_decide
example : (w*w' |> normalize |>.toDebugString) = "⟦0*1⟧∞" := by native_decide

-- 𝔁₀ 𝓭𝔁₀ 𝓮₀