import ..mcrl2_encap.mcrl2_encap

open mcrl2

variable {α : Type}
variable [comm_semigroup_with_zero α]
variable {β : Type}

/- Lemmas used to reason on the quotient. Necessary for the proofs of the axioms. -/

lemma mcrl2'.quot_alt {x y : mcrl2' α} :
quot.out (mcrl2'.base.alt x y) ≈ (quot.out x) + (quot.out y) :=
begin
  apply quot.induction_on₂ x y,
  intros a b,
  simp [mcrl2_base.alt, quotient.lift₂, quotient.lift],
  have h : quot.out ⟦a + b⟧ ≈ a + b := by exact quotient.mk_out (a + b),
  have h' : (quot.mk setoid.r a).out ≈ a := by exact quotient.mk_out _,
  have h'' : (quot.mk setoid.r b).out ≈ b := by exact quotient.mk_out _,
  apply setoid.trans,
  exact h,
  apply bisim.alt,
  repeat {apply setoid.symm; assumption}
end

lemma mcrl2'.quot_seq {x y : mcrl2' α} :
quot.out (mcrl2'.base.seq x y) ≈ (quot.out x) ⬝ (quot.out y) :=
begin
  apply quot.induction_on₂ x y,
  intros a b,
  simp [mcrl2_base.seq, quotient.lift₂, quotient.lift],
  apply setoid.trans,
  exact quotient.mk_out _,
  apply bisim.seq,
  repeat {apply setoid.symm; exact quotient.mk_out _}
end

lemma mcrl2'.quot_parl {x y : mcrl2' α} :
quot.out (mcrl2'.mrg.parl x y) ≈ (quot.out x) |_ (quot.out y) :=
begin
  apply quot.induction_on₂ x y,
  intros a b,
  simp [mcrl2_mrg.parl, quotient.lift₂, quotient.lift],
  apply setoid.trans,
  exact quotient.mk_out _,
  apply bisim.parl,
  repeat {apply setoid.symm; exact quotient.mk_out _}
end

lemma mcrl2'.quot_par {x y : mcrl2' α} :
quot.out (mcrl2'.mrg.par x y) ≈ (quot.out x) || (quot.out y) :=
begin
  apply quot.induction_on₂ x y,
  intros a b,
  simp [mcrl2_mrg.par, quotient.lift₂, quotient.lift],
  apply setoid.trans,
  exact quotient.mk_out _,
  apply bisim.par,
  repeat {apply setoid.symm; exact quotient.mk_out _}
end

lemma mcrl2'.quot_comm {x y : mcrl2' α} :
quot.out (mcrl2'.mrg.comm x y) ≈ (quot.out x) ∣ (quot.out y) :=
begin
  apply quot.induction_on₂ x y,
  intros a b,
  simp [mcrl2_mrg.comm, quotient.lift₂, quotient.lift],
  apply setoid.trans,
  exact quotient.mk_out _,
  apply bisim.comm,
  repeat {apply setoid.symm; exact quotient.mk_out _}
end

lemma mcrl2'.quot_encap {x  : mcrl2' α} {H : set α} :
quot.out (mcrl2'.encap.encap H x) ≈ encap H (x.out) :=
begin
  apply quot.induction_on x ,
  intro b,
  simp [mcrl2_encap.encap, quotient.lift],
  apply setoid.trans,
  exact quotient.mk_out _,
  apply bisim.encap,
  apply setoid.symm,
  exact quotient.mk_out _
end


import tactic

-- what's a structure?

structure group' (G : Type) [has_mul G] [has_one G] [has_inv G] :=
(mul_assoc : ∀ a b c : G, (a * b) * c = a * (b * c))
(one_mul : ∀ a : G, 1 * a = a)
(mul_one : ∀ a : G, a * 1 = a)
(mul_left_inv : ∀ a : G, a⁻¹ * a = 1)

-- easy structure

@[ext] structure silly :=
(sillyint : ℤ)
(sillynat : ℕ)

#print prefix silly

/-
silly.sillyint : silly → ℤ
silly.sillynat : silly → ℕ
silly.mk : ℤ → ℕ → silly
silly.rec -- useful for induction
silly.ext : ∀ (x y : silly), x.sillyint = y.sillyint → x.sillynat = y.sillynat → x = y
silly.ext_iff : ∀ (x y : silly), x = y ↔ x.sillyint = y.sillyint ∧ x.sillynat = y.sillynat

-/

-- #check silly -- silly : Type, i.e. silly is a Type

-- how to make a term of type silly

def x : silly := silly.mk 7 37

def y : silly :=
{ sillyint := 0,
  sillynat := 1
}

-- silly is an implementation of ℤ × ℕ
-- ℤ × ℕ is another implentation of this

example : x ≠ y :=
begin
  intro h,
  rw silly.ext_iff at h,
  cases h,
  simp [x,y] at *,
  linarith [x, y],
end

-- proof that silly is the same as ℤ × ℕ

example : silly ≃ ℤ × ℕ :=
{ to_fun := λ s, ⟨s.sillyint, s.sillynat⟩,
  inv_fun := λ x, {sillyint := x.1, sillynat := x.2},
  left_inv := λ s, by {ext; refl},
  right_inv := λ x, by {ext; refl}
}


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

! This file was ported from Lean 3 source module data.sigma.order
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Sigma.Lex
import Mathbin.Order.BoundedOrder

/-!
# Orders on a sigma type

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

This file defines two orders on a sigma type:
* The disjoint sum of orders. `a` is less `b` iff `a` and `b` are in the same summand and `a` is
  less than `b` there.
* The lexicographical order. `a` is less than `b` if its summand is strictly less than the summand
  of `b` or they are in the same summand and `a` is less than `b` there.

We make the disjoint sum of orders the default set of instances. The lexicographic order goes on a
type synonym.

## Notation

* `Σₗ i, α i`: Sigma type equipped with the lexicographic order. Type synonym of `Σ i, α i`.

## See also

Related files are:
* `data.finset.colex`: Colexicographic order on finite sets.
* `data.list.lex`: Lexicographic order on lists.
* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`.
* `data.psigma.order`: Lexicographic order on `Σₗ' i, α i`. Basically a twin of this file.
* `data.prod.lex`: Lexicographic order on `α × β`.

## TODO

Upgrade `equiv.sigma_congr_left`, `equiv.sigma_congr`, `equiv.sigma_assoc`,
`equiv.sigma_prod_of_equiv`, `equiv.sigma_equiv_prod`, ... to order isomorphisms.
-/

namespace Sigma

variable {ι : Type _} {α : ι → Type _}

/-! ### Disjoint sum of orders on `sigma` -/

#print Sigma.le /-
/-- Disjoint sum of orders. `⟨i, a⟩ ≤ ⟨j, b⟩` iff `i = j` and `a ≤ b`. -/
inductive le [∀ i, LE (α i)] : ∀ a b : Σi, α i, Prop
  | fiber (i : ι) (a b : α i) : a ≤ b → le ⟨i, a⟩ ⟨i, b⟩
#align sigma.le Sigma.le
-/

#print Sigma.lt /-
/-- Disjoint sum of orders. `⟨i, a⟩ < ⟨j, b⟩` iff `i = j` and `a < b`. -/
inductive lt [∀ i, LT (α i)] : ∀ a b : Σi, α i, Prop
  | fiber (i : ι) (a b : α i) : a < b → lt ⟨i, a⟩ ⟨i, b⟩
#align sigma.lt Sigma.lt
-/

instance [∀ i, LE (α i)] : LE (Σi, α i) :=
  ⟨le⟩

instance [∀ i, LT (α i)] : LT (Σi, α i) :=
  ⟨lt⟩

#print Sigma.mk_le_mk_iff /-
@[simp]
theorem mk_le_mk_iff [∀ i, LE (α i)] {i : ι} {a b : α i} : (⟨i, a⟩ : Sigma α) ≤ ⟨i, b⟩ ↔ a ≤ b :=
  ⟨fun ⟨_, _, _, h⟩ => h, le.fiber _ _ _⟩
#align sigma.mk_le_mk_iff Sigma.mk_le_mk_iff
-/

#print Sigma.mk_lt_mk_iff /-
@[simp]
theorem mk_lt_mk_iff [∀ i, LT (α i)] {i : ι} {a b : α i} : (⟨i, a⟩ : Sigma α) < ⟨i, b⟩ ↔ a < b :=
  ⟨fun ⟨_, _, _, h⟩ => h, lt.fiber _ _ _⟩
#align sigma.mk_lt_mk_iff Sigma.mk_lt_mk_iff
-/

#print Sigma.le_def /-
theorem le_def [∀ i, LE (α i)] {a b : Σi, α i} : a ≤ b ↔ ∃ h : a.1 = b.1, h.rec a.2 ≤ b.2 :=
  by
  constructor
  · rintro ⟨i, a, b, h⟩
    exact ⟨rfl, h⟩
  · obtain ⟨i, a⟩ := a
    obtain ⟨j, b⟩ := b
    rintro ⟨rfl : i = j, h⟩
    exact le.fiber _ _ _ h
#align sigma.le_def Sigma.le_def
-/

#print Sigma.lt_def /-
theorem lt_def [∀ i, LT (α i)] {a b : Σi, α i} : a < b ↔ ∃ h : a.1 = b.1, h.rec a.2 < b.2 :=
  by
  constructor
  · rintro ⟨i, a, b, h⟩
    exact ⟨rfl, h⟩
  · obtain ⟨i, a⟩ := a
    obtain ⟨j, b⟩ := b
    rintro ⟨rfl : i = j, h⟩
    exact lt.fiber _ _ _ h
#align sigma.lt_def Sigma.lt_def
-/

instance [∀ i, Preorder (α i)] : Preorder (Σi, α i) :=
  { Sigma.hasLe,
    Sigma.hasLt with
    le_refl := fun ⟨i, a⟩ => le.fiber i a a le_rfl
    le_trans := by
      rintro _ _ _ ⟨i, a, b, hab⟩ ⟨_, _, c, hbc⟩
      exact le.fiber i a c (hab.trans hbc)
    lt_iff_le_not_le := fun _ _ => by
      constructor
      · rintro ⟨i, a, b, hab⟩
        rwa [mk_le_mk_iff, mk_le_mk_iff, ← lt_iff_le_not_le]
      · rintro ⟨⟨i, a, b, hab⟩, h⟩
        rw [mk_le_mk_iff] at h
        exact mk_lt_mk_iff.2 (hab.lt_of_not_le h) }

instance [∀ i, PartialOrder (α i)] : PartialOrder (Σi, α i) :=
  { Sigma.preorder with
    le_antisymm := by
      rintro _ _ ⟨i, a, b, hab⟩ ⟨_, _, _, hba⟩
      exact ext rfl (hEq_of_eq <| hab.antisymm hba) }

instance [∀ i, Preorder (α i)] [∀ i, DenselyOrdered (α i)] : DenselyOrdered (Σi, α i) :=
  ⟨by
    rintro ⟨i, a⟩ ⟨_, _⟩ ⟨_, _, b, h⟩
    obtain ⟨c, ha, hb⟩ := exists_between h
    exact ⟨⟨i, c⟩, lt.fiber i a c ha, lt.fiber i c b hb⟩⟩

/-! ### Lexicographical order on `sigma` -/

namespace Lex

-- mathport name: «exprΣₗ , »
notation3"Σₗ "(...)", "r:(scoped p => Lex Sigma p) => r

#print Sigma.Lex.LE /-
/-- The lexicographical `≤` on a sigma type. -/
instance LE [LT ι] [∀ i, LE (α i)] : LE (Σₗ i, α i) :=
  ⟨Lex (· < ·) fun i => (· ≤ ·)⟩
#align sigma.lex.has_le Sigma.Lex.LE
-/

#print Sigma.Lex.LT /-
/-- The lexicographical `<` on a sigma type. -/
instance LT [LT ι] [∀ i, LT (α i)] : LT (Σₗ i, α i) :=
  ⟨Lex (· < ·) fun i => (· < ·)⟩
#align sigma.lex.has_lt Sigma.Lex.LT
-/

/- warning: sigma.lex.le_def -> Sigma.Lex.le_def is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : LT.{u1} ι] [_inst_2 : forall (i : ι), LE.{u2} (α i)] {a : Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))} {b : Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))}, Iff (LE.le.{max u1 u2} (Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) _inst_1 (fun (i : ι) => _inst_2 i)) a b) (Or (LT.lt.{u1} ι _inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Exists.{0} (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) => LE.le.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) b))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : LT.{u2} ι] [_inst_2 : forall (i : ι), LE.{u1} (α i)] {a : Lex.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))} {b : Lex.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))}, Iff (LE.le.{max u2 u1} (Lex.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u2, u1} ι (fun (i : ι) => α i) _inst_1 (fun (i : ι) => _inst_2 i)) a b) (Or (LT.lt.{u2} ι _inst_1 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Exists.{0} (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) => LE.le.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Eq.rec.{succ u1, succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Sigma.Order._hyg.1523 : ι) (x._@.Mathlib.Data.Sigma.Order._hyg.1522 : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Sigma.Order._hyg.1523) => α x._@.Mathlib.Data.Sigma.Order._hyg.1523) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) b))))
Case conversion may be inaccurate. Consider using '#align sigma.lex.le_def Sigma.Lex.le_defₓ'. -/
theorem le_def [LT ι] [∀ i, LE (α i)] {a b : Σₗ i, α i} :
    a ≤ b ↔ a.1 < b.1 ∨ ∃ h : a.1 = b.1, h.rec a.2 ≤ b.2 :=
  Sigma.lex_iff
#align sigma.lex.le_def Sigma.Lex.le_def

/- warning: sigma.lex.lt_def -> Sigma.Lex.lt_def is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : LT.{u1} ι] [_inst_2 : forall (i : ι), LT.{u2} (α i)] {a : Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))} {b : Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))}, Iff (LT.lt.{max u1 u2} (Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LT.{u1, u2} ι (fun (i : ι) => α i) _inst_1 (fun (i : ι) => _inst_2 i)) a b) (Or (LT.lt.{u1} ι _inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Exists.{0} (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) => LT.lt.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) b))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : LT.{u2} ι] [_inst_2 : forall (i : ι), LT.{u1} (α i)] {a : Lex.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))} {b : Lex.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))}, Iff (LT.lt.{max u2 u1} (Lex.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Sigma.Lex.LT.{u2, u1} ι (fun (i : ι) => α i) _inst_1 (fun (i : ι) => _inst_2 i)) a b) (Or (LT.lt.{u2} ι _inst_1 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Exists.{0} (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) => LT.lt.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Eq.rec.{succ u1, succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Sigma.Order._hyg.1623 : ι) (x._@.Mathlib.Data.Sigma.Order._hyg.1622 : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Sigma.Order._hyg.1623) => α x._@.Mathlib.Data.Sigma.Order._hyg.1623) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) b))))
Case conversion may be inaccurate. Consider using '#align sigma.lex.lt_def Sigma.Lex.lt_defₓ'. -/
theorem lt_def [LT ι] [∀ i, LT (α i)] {a b : Σₗ i, α i} :
    a < b ↔ a.1 < b.1 ∨ ∃ h : a.1 = b.1, h.rec a.2 < b.2 :=
  Sigma.lex_iff
#align sigma.lex.lt_def Sigma.Lex.lt_def

#print Sigma.Lex.preorder /-
/-- The lexicographical preorder on a sigma type. -/
instance preorder [Preorder ι] [∀ i, Preorder (α i)] : Preorder (Σₗ i, α i) :=
  { Lex.LE, Lex.LT with
    le_refl := fun ⟨i, a⟩ => Lex.right a a le_rfl
    le_trans := fun _ _ _ => trans_of (Lex (· < ·) fun _ => (· ≤ ·))
    lt_iff_le_not_le :=
      by
      refine' fun a b => ⟨fun hab => ⟨hab.mono_right fun i a b => le_of_lt, _⟩, _⟩
      · rintro (⟨b, a, hji⟩ | ⟨b, a, hba⟩) <;> obtain ⟨_, _, hij⟩ | ⟨_, _, hab⟩ := hab
        · exact hij.not_lt hji
        · exact lt_irrefl _ hji
        · exact lt_irrefl _ hij
        · exact hab.not_le hba
      · rintro ⟨⟨a, b, hij⟩ | ⟨a, b, hab⟩, hba⟩
        · exact lex.left _ _ hij
        · exact lex.right _ _ (hab.lt_of_not_le fun h => hba <| lex.right _ _ h) }
#align sigma.lex.preorder Sigma.Lex.preorder
-/

#print Sigma.Lex.partialOrder /-
/-- The lexicographical partial order on a sigma type. -/
instance partialOrder [Preorder ι] [∀ i, PartialOrder (α i)] : PartialOrder (Σₗ i, α i) :=
  { Lex.preorder with le_antisymm := fun _ _ => antisymm_of (Lex (· < ·) fun _ => (· ≤ ·)) }
#align sigma.lex.partial_order Sigma.Lex.partialOrder
-/

#print Sigma.Lex.linearOrder /-
/-- The lexicographical linear order on a sigma type. -/
instance linearOrder [LinearOrder ι] [∀ i, LinearOrder (α i)] : LinearOrder (Σₗ i, α i) :=
  { Lex.partialOrder with
    le_total := total_of (Lex (· < ·) fun _ => (· ≤ ·))
    DecidableEq := Sigma.decidableEq
    decidableLe := Lex.decidable _ _ }
#align sigma.lex.linear_order Sigma.Lex.linearOrder
-/

/- warning: sigma.lex.order_bot -> Sigma.Lex.orderBot is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : PartialOrder.{u1} ι] [_inst_2 : OrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1))] [_inst_3 : forall (i : ι), Preorder.{u2} (α i)] [_inst_4 : OrderBot.{u2} (α (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (Preorder.toLE.{u2} (α (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (_inst_3 (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))))], OrderBot.{max u1 u2} (Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (fun (i : ι) => Preorder.toLE.{u2} (α i) (_inst_3 i)))
but is expected to have type
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : PartialOrder.{u1} ι] [_inst_2 : OrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1))] [_inst_3 : forall (i : ι), Preorder.{u2} (α i)] [_inst_4 : OrderBot.{u2} (α (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (Preorder.toLE.{u2} (α (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (_inst_3 (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))))], OrderBot.{max u2 u1} (Lex.{max u2 u1} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (fun (i : ι) => Preorder.toLE.{u2} (α i) (_inst_3 i)))
Case conversion may be inaccurate. Consider using '#align sigma.lex.order_bot Sigma.Lex.orderBotₓ'. -/
/-- The lexicographical linear order on a sigma type. -/
instance orderBot [PartialOrder ι] [OrderBot ι] [∀ i, Preorder (α i)] [OrderBot (α ⊥)] :
    OrderBot (Σₗ i, α i) where
  bot := ⟨⊥, ⊥⟩
  bot_le := fun ⟨a, b⟩ => by
    obtain rfl | ha := eq_bot_or_bot_lt a
    · exact lex.right _ _ bot_le
    · exact lex.left _ _ ha
#align sigma.lex.order_bot Sigma.Lex.orderBot

/- warning: sigma.lex.order_top -> Sigma.Lex.orderTop is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : PartialOrder.{u1} ι] [_inst_2 : OrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1))] [_inst_3 : forall (i : ι), Preorder.{u2} (α i)] [_inst_4 : OrderTop.{u2} (α (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (Preorder.toLE.{u2} (α (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (_inst_3 (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))))], OrderTop.{max u1 u2} (Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (fun (i : ι) => Preorder.toLE.{u2} (α i) (_inst_3 i)))
but is expected to have type
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : PartialOrder.{u1} ι] [_inst_2 : OrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1))] [_inst_3 : forall (i : ι), Preorder.{u2} (α i)] [_inst_4 : OrderTop.{u2} (α (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (Preorder.toLE.{u2} (α (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))) (_inst_3 (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2))))], OrderTop.{max u2 u1} (Lex.{max u2 u1} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (fun (i : ι) => Preorder.toLE.{u2} (α i) (_inst_3 i)))
Case conversion may be inaccurate. Consider using '#align sigma.lex.order_top Sigma.Lex.orderTopₓ'. -/
/-- The lexicographical linear order on a sigma type. -/
instance orderTop [PartialOrder ι] [OrderTop ι] [∀ i, Preorder (α i)] [OrderTop (α ⊤)] :
    OrderTop (Σₗ i, α i) where
  top := ⟨⊤, ⊤⟩
  le_top := fun ⟨a, b⟩ => by
    obtain rfl | ha := eq_top_or_lt_top a
    · exact lex.right _ _ le_top
    · exact lex.left _ _ ha
#align sigma.lex.order_top Sigma.Lex.orderTop

/- warning: sigma.lex.bounded_order -> Sigma.Lex.boundedOrder is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : PartialOrder.{u1} ι] [_inst_2 : BoundedOrder.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1))] [_inst_3 : forall (i : ι), Preorder.{u2} (α i)] [_inst_4 : OrderBot.{u2} (α (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (Preorder.toLE.{u2} (α (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (_inst_3 (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))))] [_inst_5 : OrderTop.{u2} (α (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (Preorder.toLE.{u2} (α (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (_inst_3 (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))))], BoundedOrder.{max u1 u2} (Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (fun (i : ι) => Preorder.toLE.{u2} (α i) (_inst_3 i)))
but is expected to have type
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : PartialOrder.{u1} ι] [_inst_2 : BoundedOrder.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1))] [_inst_3 : forall (i : ι), Preorder.{u2} (α i)] [_inst_4 : OrderBot.{u2} (α (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (Preorder.toLE.{u2} (α (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (_inst_3 (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))))] [_inst_5 : OrderTop.{u2} (α (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (Preorder.toLE.{u2} (α (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))) (_inst_3 (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (BoundedOrder.toOrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) _inst_2)))))], BoundedOrder.{max u2 u1} (Lex.{max u2 u1} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LE.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι _inst_1)) (fun (i : ι) => Preorder.toLE.{u2} (α i) (_inst_3 i)))
Case conversion may be inaccurate. Consider using '#align sigma.lex.bounded_order Sigma.Lex.boundedOrderₓ'. -/
/-- The lexicographical linear order on a sigma type. -/
instance boundedOrder [PartialOrder ι] [BoundedOrder ι] [∀ i, Preorder (α i)] [OrderBot (α ⊥)]
    [OrderTop (α ⊤)] : BoundedOrder (Σₗ i, α i) :=
  { Lex.orderBot, Lex.orderTop with }
#align sigma.lex.bounded_order Sigma.Lex.boundedOrder

#print Sigma.Lex.denselyOrdered /-
instance denselyOrdered [Preorder ι] [DenselyOrdered ι] [∀ i, Nonempty (α i)] [∀ i, Preorder (α i)]
    [∀ i, DenselyOrdered (α i)] : DenselyOrdered (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩)
    · obtain ⟨k, hi, hj⟩ := exists_between h
      obtain ⟨c⟩ : Nonempty (α k) := inferInstance
      exact ⟨⟨k, c⟩, left _ _ hi, left _ _ hj⟩
    · obtain ⟨c, ha, hb⟩ := exists_between h
      exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩⟩
#align sigma.lex.densely_ordered Sigma.Lex.denselyOrdered
-/

#print Sigma.Lex.denselyOrdered_of_noMaxOrder /-
instance denselyOrdered_of_noMaxOrder [Preorder ι] [∀ i, Preorder (α i)] [∀ i, DenselyOrdered (α i)]
    [∀ i, NoMaxOrder (α i)] : DenselyOrdered (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩)
    · obtain ⟨c, ha⟩ := exists_gt a
      exact ⟨⟨i, c⟩, right _ _ ha, left _ _ h⟩
    · obtain ⟨c, ha, hb⟩ := exists_between h
      exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩⟩
#align sigma.lex.densely_ordered_of_no_max_order Sigma.Lex.denselyOrdered_of_noMaxOrder
-/

#print Sigma.Lex.denselyOrdered_of_noMinOrder /-
instance denselyOrdered_of_noMinOrder [Preorder ι] [∀ i, Preorder (α i)] [∀ i, DenselyOrdered (α i)]
    [∀ i, NoMinOrder (α i)] : DenselyOrdered (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩)
    · obtain ⟨c, hb⟩ := exists_lt b
      exact ⟨⟨j, c⟩, left _ _ h, right _ _ hb⟩
    · obtain ⟨c, ha, hb⟩ := exists_between h
      exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩⟩
#align sigma.lex.densely_ordered_of_no_min_order Sigma.Lex.denselyOrdered_of_noMinOrder
-/

#print Sigma.Lex.noMaxOrder_of_nonempty /-
instance noMaxOrder_of_nonempty [Preorder ι] [∀ i, Preorder (α i)] [NoMaxOrder ι]
    [∀ i, Nonempty (α i)] : NoMaxOrder (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩
    obtain ⟨j, h⟩ := exists_gt i
    obtain ⟨b⟩ : Nonempty (α j) := inferInstance
    exact ⟨⟨j, b⟩, left _ _ h⟩⟩
#align sigma.lex.no_max_order_of_nonempty Sigma.Lex.noMaxOrder_of_nonempty
-/

/- warning: sigma.lex.no_min_order_of_nonempty clashes with [anonymous] -> [anonymous]
warning: sigma.lex.no_min_order_of_nonempty -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : Preorder.{u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : NoMaxOrder.{u1} ι (Preorder.toLT.{u1} ι _inst_1)] [_inst_4 : forall (i : ι), Nonempty.{succ u2} (α i)], NoMaxOrder.{max u1 u2} (Lex.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Sigma.Lex.LT.{u1, u2} ι (fun (i : ι) => α i) (Preorder.toLT.{u1} ι _inst_1) (fun (i : ι) => Preorder.toLT.{u2} (α i) (_inst_2 i)))
but is expected to have type
  forall {ι : Type.{u1}} {α : Type.{u2}}, (Nat -> ι -> α) -> Nat -> (List.{u1} ι) -> (List.{u2} α)
Case conversion may be inaccurate. Consider using '#align sigma.lex.no_min_order_of_nonempty [anonymous]ₓ'. -/
instance [anonymous] [Preorder ι] [∀ i, Preorder (α i)] [NoMaxOrder ι] [∀ i, Nonempty (α i)] :
    NoMaxOrder (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩
    obtain ⟨j, h⟩ := exists_gt i
    obtain ⟨b⟩ : Nonempty (α j) := inferInstance
    exact ⟨⟨j, b⟩, left _ _ h⟩⟩
#align sigma.lex.no_min_order_of_nonempty [anonymous]

#print Sigma.Lex.noMaxOrder /-
instance noMaxOrder [Preorder ι] [∀ i, Preorder (α i)] [∀ i, NoMaxOrder (α i)] :
    NoMaxOrder (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩
    obtain ⟨b, h⟩ := exists_gt a
    exact ⟨⟨i, b⟩, right _ _ h⟩⟩
#align sigma.lex.no_max_order Sigma.Lex.noMaxOrder
-/

#print Sigma.Lex.noMinOrder /-
instance noMinOrder [Preorder ι] [∀ i, Preorder (α i)] [∀ i, NoMinOrder (α i)] :
    NoMinOrder (Σₗ i, α i) :=
  ⟨by
    rintro ⟨i, a⟩
    obtain ⟨b, h⟩ := exists_lt a
    exact ⟨⟨i, b⟩, right _ _ h⟩⟩
#align sigma.lex.no_min_order Sigma.Lex.noMinOrder
-/

end Lex

end Sigma


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro
-/

import data.mv_polynomial.basic

/-!
# Renaming variables of polynomials

This file establishes the `rename` operation on multivariate polynomials,
which modifies the set of variables.

## Main declarations

* `mv_polynomial.rename`
* `mv_polynomial.rename_equiv`

## Notation

As in other polynomial files, we typically use the notation:

+ `σ τ α : Type*` (indexing the variables)

+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `r : R` elements of the coefficient ring

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ α`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

variables {σ τ α R S : Type*} [comm_semiring R] [comm_semiring S]

namespace mv_polynomial

section rename

/-- Rename all the variables in a multivariable polynomial. -/
def rename (f : σ → τ) : mv_polynomial σ R →ₐ[R] mv_polynomial τ R :=
aeval (X ∘ f)

@[simp] lemma rename_C (f : σ → τ) (r : R) : rename f (C r) = C r :=
eval₂_C _ _ _

@[simp] lemma rename_X (f : σ → τ) (i : σ) : rename f (X i : mv_polynomial σ R) = X (f i) :=
eval₂_X _ _ _

lemma map_rename (f : R →+* S) (g : σ → τ) (p : mv_polynomial σ R) :
  map f (rename g p) = rename g (map f p) :=
mv_polynomial.induction_on p
  (λ a, by simp only [map_C, rename_C])
  (λ p q hp hq, by simp only [hp, hq, alg_hom.map_add, ring_hom.map_add])
  (λ p n hp, by simp only [hp, rename_X, map_X, ring_hom.map_mul, alg_hom.map_mul])

@[simp] lemma rename_rename (f : σ → τ) (g : τ → α) (p : mv_polynomial σ R) :
  rename g (rename f p) = rename (g ∘ f) p :=
show rename g (eval₂ C (X ∘ f) p) = _,
begin
  simp only [rename, aeval_eq_eval₂_hom],
  simp [eval₂_comp_left _ C (X ∘ f) p, (∘), eval₂_C, eval_X],
  apply eval₂_hom_congr _ rfl rfl,
  ext1, simp only [comp_app, ring_hom.coe_comp, eval₂_hom_C],
end

@[simp] lemma rename_id (p : mv_polynomial σ R) : rename id p = p :=
eval₂_eta p

lemma rename_monomial (f : σ → τ) (d : σ →₀ ℕ) (r : R) :
  rename f (monomial d r) = monomial (d.map_domain f) r :=
begin
  rw [rename, aeval_monomial, monomial_eq, finsupp.prod_map_domain_index],
  { refl },
  { exact assume n, pow_zero _ },
  { exact assume n i₁ i₂, pow_add _ _ _ }
end

lemma rename_eq (f : σ → τ) (p : mv_polynomial σ R) :
  rename f p = finsupp.map_domain (finsupp.map_domain f) p :=
begin
  simp only [rename, aeval_def, eval₂, finsupp.map_domain, ring_hom.coe_of],
  congr' with s a : 2,
  rw [← monomial, monomial_eq, finsupp.prod_sum_index],
  congr' with n i : 2,
  rw [finsupp.prod_single_index],
  exact pow_zero _,
  exact assume a, pow_zero _,
  exact assume a b c, pow_add _ _ _
end

lemma rename_injective (f : σ → τ) (hf : function.injective f) :
  function.injective (rename f : mv_polynomial σ R → mv_polynomial τ R) :=
have (rename f : mv_polynomial σ R → mv_polynomial τ R) =
  finsupp.map_domain (finsupp.map_domain f) := funext (rename_eq f),
begin
  rw this,
  exact finsupp.map_domain_injective (finsupp.map_domain_injective hf)
end

section
variables (R)

/-- `mv_polynomial.rename e` is an equivalence when `e` is. -/
@[simps apply]
def rename_equiv (f : σ ≃ τ) : mv_polynomial σ R ≃ₐ[R] mv_polynomial τ R :=
{ to_fun := rename f,
  inv_fun := rename f.symm,
  left_inv := λ p, by rw [rename_rename, f.symm_comp_self, rename_id],
  right_inv := λ p, by rw [rename_rename, f.self_comp_symm, rename_id],
  ..rename f}

@[simp] lemma rename_equiv_refl :
  rename_equiv R (equiv.refl σ) = alg_equiv.refl :=
alg_equiv.ext rename_id

@[simp] lemma rename_equiv_symm (f : σ ≃ τ) :
  (rename_equiv R f).symm = rename_equiv R f.symm := rfl

@[simp] lemma rename_equiv_trans (e : σ ≃ τ) (f : τ ≃ α):
  (rename_equiv R e).trans (rename_equiv R f) = rename_equiv R (e.trans f) :=
alg_equiv.ext (rename_rename e f)

end

section
variables (f : R →+* S) (k : σ → τ) (g : τ → S) (p : mv_polynomial σ R)

lemma eval₂_rename : (rename k p).eval₂ f g = p.eval₂ f (g ∘ k) :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma eval₂_hom_rename : eval₂_hom f g (rename k p) = eval₂_hom f (g ∘ k) p :=
eval₂_rename _ _ _ _

lemma aeval_rename [algebra R S] : aeval g (rename k p) = aeval (g ∘ k) p :=
eval₂_hom_rename _ _ _ _

lemma rename_eval₂ (g : τ → mv_polynomial σ R) :
  rename k (p.eval₂ C (g ∘ k)) = (rename k p).eval₂ C (rename k ∘ g) :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma rename_prodmk_eval₂ (j : τ) (g : σ → mv_polynomial σ R) :
  rename (prod.mk j) (p.eval₂ C g) = p.eval₂ C (λ x, rename (prod.mk j) (g x)) :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma eval₂_rename_prodmk (g : σ × τ → S) (i : σ) (p : mv_polynomial τ R) :
  (rename (prod.mk i) p).eval₂ f g = eval₂ f (λ j, g (i, j)) p :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma eval_rename_prodmk (g : σ × τ → R) (i : σ) (p : mv_polynomial τ R) :
  eval g (rename (prod.mk i) p) = eval (λ j, g (i, j)) p :=
eval₂_rename_prodmk (ring_hom.id _) _ _ _

end

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_finset_rename (p : mv_polynomial σ R) :
  ∃ (s : finset σ) (q : mv_polynomial {x // x ∈ s} R), p = rename coe q :=
begin
  apply induction_on p,
  { intro r, exact ⟨∅, C r, by rw rename_C⟩ },
  { rintro p q ⟨s, p, rfl⟩ ⟨t, q, rfl⟩,
    refine ⟨s ∪ t, ⟨_, _⟩⟩,
    { refine rename (subtype.map id _) p + rename (subtype.map id _) q;
      simp only [id.def, true_or, or_true, finset.mem_union, forall_true_iff] {contextual := tt}, },
    { simp only [rename_rename, alg_hom.map_add], refl, }, },
  { rintro p n ⟨s, p, rfl⟩,
    refine ⟨insert n s, ⟨_, _⟩⟩,
  { refine rename (subtype.map id _) p * X ⟨n, s.mem_insert_self n⟩,
    simp only [id.def, or_true, finset.mem_insert, forall_true_iff] {contextual := tt}, },
    { simp only [rename_rename, rename_X, subtype.coe_mk, alg_hom.map_mul], refl, }, },
end

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_fin_rename (p : mv_polynomial σ R) :
  ∃ (n : ℕ) (f : fin n → σ) (hf : injective f) (q : mv_polynomial (fin n) R), p = rename f q :=
begin
  obtain ⟨s, q, rfl⟩ := exists_finset_rename p,
  let n := fintype.card {x // x ∈ s},
  let e := fintype.equiv_fin {x // x ∈ s},
  refine ⟨n, coe ∘ e.symm, subtype.val_injective.comp e.symm.injective, rename e q, _⟩,
  rw [← rename_rename, rename_rename e],
  simp only [function.comp, equiv.symm_apply_apply, rename_rename]
end

end rename

lemma eval₂_cast_comp (f : σ → τ) (c : ℤ →+* R) (g : τ → R) (p : mv_polynomial σ ℤ) :
  eval₂ c (g ∘ f) p = eval₂ c g (rename f p) :=
mv_polynomial.induction_on p
(λ n, by simp only [eval₂_C, rename_C])
(λ p q hp hq, by simp only [hp, hq, rename, eval₂_add, alg_hom.map_add])
(λ p n hp, by simp only [hp, rename, aeval_def, eval₂_X, eval₂_mul])

section coeff

@[simp]
lemma coeff_rename_map_domain (f : σ → τ) (hf : injective f) (φ : mv_polynomial σ R) (d : σ →₀ ℕ) :
  (rename f φ).coeff (d.map_domain f) = φ.coeff d :=
begin
  apply induction_on' φ,
  { intros u r,
    rw [rename_monomial, coeff_monomial, coeff_monomial],
    simp only [(finsupp.map_domain_injective hf).eq_iff],
    split_ifs; refl, },
  { intros, simp only [*, alg_hom.map_add, coeff_add], }
end

lemma coeff_rename_eq_zero (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ)
  (h : ∀ u : σ →₀ ℕ, u.map_domain f = d → φ.coeff u = 0) :
  (rename f φ).coeff d = 0 :=
begin
  rw [rename_eq, ← not_mem_support_iff],
  intro H,
  replace H := map_domain_support H,
  rw [finset.mem_image] at H,
  obtain ⟨u, hu, rfl⟩ := H,
  specialize h u rfl,
  simp at h hu,
  contradiction
end

lemma coeff_rename_ne_zero (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ)
  (h : (rename f φ).coeff d ≠ 0) :
  ∃ u : σ →₀ ℕ, u.map_domain f = d ∧ φ.coeff u ≠ 0 :=
by { contrapose! h, apply coeff_rename_eq_zero _ _ _ h }

@[simp] lemma constant_coeff_rename {τ : Type*} (f : σ → τ) (φ : mv_polynomial σ R) :
  constant_coeff (rename f φ) = constant_coeff φ :=
begin
  apply φ.induction_on,
  { intro a, simp only [constant_coeff_C, rename_C]},
  { intros p q hp hq, simp only [hp, hq, ring_hom.map_add, alg_hom.map_add] },
  { intros p n hp, simp only [hp, rename_X, constant_coeff_X, ring_hom.map_mul, alg_hom.map_mul] }
end

end coeff

end mv_polynomial


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Scott Morrison, Johan Commelin
-/
import data.finset.card

/-!
# Finsets in `fin n`

A few constructions for finsets in `fin n`.

## Main declarations

* `finset.fin_range`: `{0, 1, ..., n - 1}` as a `finset (fin n)`.
* `finset.attach_fin`: Turns a finset of naturals strictly less than `n` into a `finset (fin n)`.
-/

variables {n : ℕ}

namespace finset

/-- `finset.fin_range n` is the finset `{0, 1, ..., n - 1}`, as a `finset (fin n)`. -/
def fin_range (n : ℕ) : finset (fin n) := ⟨list.fin_range n, list.nodup_fin_range n⟩

@[simp]
lemma fin_range_card : (fin_range n).card = n := by simp [fin_range]

@[simp]
lemma mem_fin_range (m : fin n) : m ∈ fin_range n := list.mem_fin_range m

@[simp] lemma coe_fin_range (n : ℕ) : (fin_range n : set (fin n)) = set.univ :=
set.eq_univ_of_forall mem_fin_range

/-- Given a finset `s` of `ℕ` contained in `{0,..., n-1}`, the corresponding finset in `fin n`
is `s.attach_fin h` where `h` is a proof that all elements of `s` are less than `n`. -/
def attach_fin (s : finset ℕ) {n : ℕ} (h : ∀ m ∈ s, m < n) : finset (fin n) :=
⟨s.1.pmap (λ a ha, ⟨a, ha⟩) h, multiset.nodup_pmap (λ _ _ _ _, fin.veq_of_eq) s.2⟩

@[simp] lemma mem_attach_fin {n : ℕ} {s : finset ℕ} (h : ∀ m ∈ s, m < n) {a : fin n} :
  a ∈ s.attach_fin h ↔ (a : ℕ) ∈ s :=
⟨λ h, let ⟨b, hb₁, hb₂⟩ := multiset.mem_pmap.1 h in hb₂ ▸ hb₁,
λ h, multiset.mem_pmap.2 ⟨a, h, fin.eta _ _⟩⟩

@[simp] lemma card_attach_fin {n : ℕ} (s : finset ℕ) (h : ∀ m ∈ s, m < n) :
  (s.attach_fin h).card = s.card :=
multiset.card_pmap _ _ _

end finset


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Nicolò Cavalleri
-/
import topology.algebra.module.basic
import topology.continuous_function.ordered
import topology.algebra.uniform_group
import topology.uniform_space.compact_convergence
import algebra.algebra.subalgebra.basic
import tactic.field_simp

/-!
# Algebraic structures over continuous functions

In this file we define instances of algebraic structures over the type `continuous_map α β`
(denoted `C(α, β)`) of **bundled** continuous maps from `α` to `β`. For example, `C(α, β)`
is a group when `β` is a group, a ring when `β` is a ring, etc.

For each type of algebraic structure, we also define an appropriate subobject of `α → β`
with carrier `{ f : α → β | continuous f }`. For example, when `β` is a group, a subgroup
`continuous_subgroup α β` of `α → β` is constructed with carrier `{ f : α → β | continuous f }`.

Note that, rather than using the derived algebraic structures on these subobjects
(for example, when `β` is a group, the derived group structure on `continuous_subgroup α β`),
one should use `C(α, β)` with the appropriate instance of the structure.
-/

local attribute [elab_simple] continuous.comp

namespace continuous_functions

variables {α : Type*} {β : Type*} [topological_space α] [topological_space β]
variables {f g : {f : α → β | continuous f }}

instance : has_coe_to_fun {f : α → β | continuous f} (λ _, α → β) :=  ⟨subtype.val⟩

end continuous_functions

namespace continuous_map
variables {α : Type*} {β : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space γ]

@[to_additive]
instance has_mul [has_mul β] [has_continuous_mul β] : has_mul C(α, β) :=
⟨λ f g, ⟨f * g, continuous_mul.comp (f.continuous.prod_mk g.continuous : _)⟩⟩

@[simp, norm_cast, to_additive]
lemma coe_mul [has_mul β] [has_continuous_mul β] (f g : C(α, β)) : ⇑(f * g) = f * g := rfl

@[simp, to_additive] lemma mul_comp [has_mul γ] [has_continuous_mul γ]
  (f₁ f₂ : C(β, γ)) (g : C(α, β)) :
  (f₁ * f₂).comp g = f₁.comp g * f₂.comp g :=
rfl

@[to_additive]
instance [has_one β] : has_one C(α, β) := ⟨const α 1⟩

@[simp, norm_cast, to_additive]
lemma coe_one [has_one β]  : ⇑(1 : C(α, β)) = 1 := rfl

@[simp, to_additive] lemma one_comp [has_one γ] (g : C(α, β)) : (1 : C(β, γ)).comp g = 1 := rfl

instance has_nsmul [add_monoid β] [has_continuous_add β] : has_scalar ℕ C(α, β) :=
⟨λ n f, ⟨n • f, f.continuous.nsmul n⟩⟩

@[to_additive]
instance has_pow [monoid β] [has_continuous_mul β] : has_pow C(α, β) ℕ :=
⟨λ f n, ⟨f ^ n, f.continuous.pow n⟩⟩

@[norm_cast, to_additive]
lemma coe_pow [monoid β] [has_continuous_mul β] (f : C(α, β)) (n : ℕ) :
  ⇑(f ^ n) = f ^ n := rfl

-- don't make `coe_nsmul` simp as the linter complains it's redundant WRT `coe_smul`
attribute [simp] coe_pow

@[to_additive] lemma pow_comp [monoid γ] [has_continuous_mul γ]
  (f : C(β, γ)) (n : ℕ) (g : C(α, β)) :
  (f^n).comp g = (f.comp g)^n :=
rfl

-- don't make `nsmul_comp` simp as the linter complains it's redundant WRT `smul_comp`
attribute [simp] pow_comp

@[to_additive]
instance [group β] [topological_group β] : has_inv C(α, β) :=
{ inv := λ f, ⟨f⁻¹, f.continuous.inv⟩ }

@[simp, norm_cast, to_additive]
lemma coe_inv [group β] [topological_group β] (f : C(α, β)) :
  ⇑(f⁻¹) = f⁻¹ :=
rfl

@[simp, to_additive] lemma inv_comp [group γ] [topological_group γ] (f : C(β, γ)) (g : C(α, β)) :
  (f⁻¹).comp g = (f.comp g)⁻¹ :=
rfl

@[to_additive]
instance [has_div β] [has_continuous_div β] : has_div C(α, β) :=
{ div := λ f g, ⟨f / g, f.continuous.div' g.continuous⟩ }

@[simp, norm_cast, to_additive]
lemma coe_div [has_div β] [has_continuous_div β] (f g : C(α, β)) : ⇑(f / g) = f / g :=
rfl

@[simp, to_additive] lemma div_comp [has_div γ] [has_continuous_div γ]
  (f g : C(β, γ)) (h : C(α, β)) :
  (f / g).comp h = (f.comp h) / (g.comp h) :=
rfl

instance has_zsmul [add_group β] [topological_add_group β] : has_scalar ℤ C(α, β) :=
{ smul := λ z f, ⟨z • f, f.continuous.zsmul z⟩ }

@[to_additive]
instance has_zpow [group β] [topological_group β] :
  has_pow C(α, β) ℤ :=
{ pow := λ f z, ⟨f ^ z, f.continuous.zpow z⟩ }

@[norm_cast, to_additive]
lemma coe_zpow [group β] [topological_group β] (f : C(α, β)) (z : ℤ) :
  ⇑(f ^ z) = f ^ z :=
rfl

-- don't make `coe_zsmul` simp as the linter complains it's redundant WRT `coe_smul`
attribute [simp] coe_zpow

@[to_additive]
lemma zpow_comp [group γ] [topological_group γ] (f : C(β, γ)) (z : ℤ) (g : C(α, β)) :
  (f^z).comp g = (f.comp g)^z :=
rfl

-- don't make `zsmul_comp` simp as the linter complains it's redundant WRT `smul_comp`
attribute [simp] zpow_comp

end continuous_map

section group_structure

/-!
### Group stucture

In this section we show that continuous functions valued in a topological group inherit
the structure of a group.
-/

section subtype

/-- The `submonoid` of continuous maps `α → β`. -/
@[to_additive "The `add_submonoid` of continuous maps `α → β`. "]
def continuous_submonoid (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : submonoid (α → β) :=
{ carrier := { f : α → β | continuous f },
  one_mem' := @continuous_const _ _ _ _ 1,
  mul_mem' := λ f g fc gc, continuous.comp
    has_continuous_mul.continuous_mul (continuous.prod_mk fc gc : _) }

/-- The subgroup of continuous maps `α → β`. -/
@[to_additive "The `add_subgroup` of continuous maps `α → β`. "]
def continuous_subgroup (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  [group β] [topological_group β] : subgroup (α → β) :=
{ inv_mem' := λ f fc, continuous.inv fc,
  ..continuous_submonoid α β, }.

end subtype

namespace continuous_map

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [semigroup β] [has_continuous_mul β] : semigroup C(α, β) :=
coe_injective.semigroup _ coe_mul

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_semigroup β] [has_continuous_mul β] : comm_semigroup C(α, β) :=
coe_injective.comm_semigroup _ coe_mul

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [mul_one_class β] [has_continuous_mul β] : mul_one_class C(α, β) :=
coe_injective.mul_one_class _ coe_one coe_mul

instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [mul_zero_class β] [has_continuous_mul β] : mul_zero_class C(α, β) :=
coe_injective.mul_zero_class _ coe_zero coe_mul

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : monoid C(α, β) :=
coe_injective.monoid _ coe_one coe_mul coe_pow

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid_with_zero β] [has_continuous_mul β] : monoid_with_zero C(α, β) :=
coe_injective.monoid_with_zero _ coe_zero coe_one coe_mul coe_pow

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_monoid β] [has_continuous_mul β] : comm_monoid C(α, β) :=
coe_injective.comm_monoid _ coe_one coe_mul coe_pow

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [comm_monoid_with_zero β] [has_continuous_mul β] : comm_monoid_with_zero C(α, β) :=
coe_injective.comm_monoid_with_zero _ coe_zero coe_one coe_mul coe_pow

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [locally_compact_space α] [topological_space β]
  [has_mul β] [has_continuous_mul β] : has_continuous_mul C(α, β) :=
⟨begin
  refine continuous_of_continuous_uncurry _ _,
  have h1 : continuous (λ x : (C(α, β) × C(α, β)) × α, x.fst.fst x.snd) :=
    continuous_eval'.comp (continuous_fst.prod_map continuous_id),
  have h2 : continuous (λ x : (C(α, β) × C(α, β)) × α, x.fst.snd x.snd) :=
    continuous_eval'.comp (continuous_snd.prod_map continuous_id),
  exact h1.mul h2,
end⟩

/-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
@[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
  simps]
def coe_fn_monoid_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : C(α, β) →* (α → β) :=
{ to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }

/-- Composition on the left by a (continuous) homomorphism of topological monoids, as a
`monoid_hom`. Similar to `monoid_hom.comp_left`. -/
@[to_additive "Composition on the left by a (continuous) homomorphism of topological `add_monoid`s,
as an `add_monoid_hom`. Similar to `add_monoid_hom.comp_left`.", simps]
protected def _root_.monoid_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [monoid β] [has_continuous_mul β]
  [topological_space γ] [monoid γ] [has_continuous_mul γ] (g : β →* γ) (hg : continuous g)  :
  C(α, β) →* C(α, γ) :=
{ to_fun := λ f, (⟨g, hg⟩ : C(β, γ)).comp f,
  map_one' := ext $ λ x, g.map_one,
  map_mul' := λ f₁ f₂, ext $ λ x, g.map_mul _ _ }

/-- Composition on the right as a `monoid_hom`. Similar to `monoid_hom.comp_hom'`. -/
@[to_additive "Composition on the right as an `add_monoid_hom`. Similar to
`add_monoid_hom.comp_hom'`.", simps]
def comp_monoid_hom' {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [mul_one_class γ] [has_continuous_mul γ] (g : C(α, β)) : C(β, γ) →* C(α, γ) :=
{ to_fun := λ f, f.comp g, map_one' := one_comp g, map_mul' := λ f₁ f₂, mul_comp f₁ f₂ g }

open_locale big_operators
@[simp, to_additive] lemma coe_prod {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → C(α, β)) :
  ⇑(∏ i in s, f i) = (∏ i in s, (f i : α → β)) :=
(coe_fn_monoid_hom : C(α, β) →* _).map_prod f s

@[to_additive]
lemma prod_apply {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → C(α, β)) (a : α) :
  (∏ i in s, f i) a = (∏ i in s, f i a) :=
by simp

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] : group C(α, β) :=
coe_injective.group _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_group β] [topological_group β] : comm_group C(α, β) :=
coe_injective.comm_group _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow

@[to_additive] instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_group β] [topological_group β] : topological_group C(α, β) :=
{ continuous_mul := by
  { letI : uniform_space β := topological_group.to_uniform_space β,
    have : uniform_group β := topological_group_is_uniform,
    rw continuous_iff_continuous_at,
    rintros ⟨f, g⟩,
    rw [continuous_at, tendsto_iff_forall_compact_tendsto_uniformly_on, nhds_prod_eq],
    exactI λ K hK, ((tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).prod
      (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK)).comp'
      uniform_continuous_mul },
  continuous_inv := by
  { letI : uniform_space β := topological_group.to_uniform_space β,
    have : uniform_group β := topological_group_is_uniform,
    rw continuous_iff_continuous_at,
    intro f,
    rw [continuous_at, tendsto_iff_forall_compact_tendsto_uniformly_on],
    exactI λ K hK, (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).comp'
      uniform_continuous_inv } }

end continuous_map

end group_structure

section ring_structure

/-!
### Ring stucture

In this section we show that continuous functions valued in a topological semiring `R` inherit
the structure of a ring.
-/

section subtype

/-- The subsemiring of continuous maps `α → β`. -/
def continuous_subsemiring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
  [semiring R] [topological_semiring R] : subsemiring (α → R) :=
{ ..continuous_add_submonoid α R,
  ..continuous_submonoid α R }

/-- The subring of continuous maps `α → β`. -/
def continuous_subring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
  [ring R] [topological_ring R] : subring (α → R) :=
{ ..continuous_subsemiring α R,
  ..continuous_add_subgroup α R }

end subtype

namespace continuous_map

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [semiring β] [topological_semiring β] : semiring C(α, β) :=
{ left_distrib := λ a b c, by ext; exact left_distrib _ _ _,
  right_distrib := λ a b c, by ext; exact right_distrib _ _ _,
  ..continuous_map.add_comm_monoid,
  ..continuous_map.monoid_with_zero }

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [ring β] [topological_ring β] : ring C(α, β) :=
{ ..continuous_map.semiring,
  ..continuous_map.add_comm_group, }

instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_semiring β] [topological_semiring β] : comm_semiring C(α, β) :=
{ ..continuous_map.semiring,
  ..continuous_map.comm_monoid, }

instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_ring β] [topological_ring β] : comm_ring C(α, β) :=
{ ..continuous_map.comm_semiring,
  ..continuous_map.ring, }

/-- Composition on the left by a (continuous) homomorphism of topological semirings, as a
`ring_hom`.  Similar to `ring_hom.comp_left`. -/
@[simps] protected def _root_.ring_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [semiring β] [topological_semiring β]
  [topological_space γ] [semiring γ] [topological_semiring γ] (g : β →+* γ) (hg : continuous g) :
  C(α, β) →+* C(α, γ) :=
{ .. g.to_monoid_hom.comp_left_continuous α hg,
  .. g.to_add_monoid_hom.comp_left_continuous α hg }

/-- Coercion to a function as a `ring_hom`. -/
@[simps]
def coe_fn_ring_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [ring β] [topological_ring β] : C(α, β) →+* (α → β) :=
{ to_fun := coe_fn,
  ..(coe_fn_monoid_hom : C(α, β) →* _),
  ..(coe_fn_add_monoid_hom : C(α, β) →+ _) }

end continuous_map

end ring_structure

local attribute [ext] subtype.eq

section module_structure

/-!
### Semiodule stucture

In this section we show that continuous functions valued in a topological module `M` over a
topological semiring `R` inherit the structure of a module.
-/

section subtype

variables (α : Type*) [topological_space α]
variables (R : Type*) [semiring R]
variables (M : Type*) [topological_space M] [add_comm_group M]
variables [module R M] [has_continuous_const_smul R M] [topological_add_group M]

/-- The `R`-submodule of continuous maps `α → M`. -/
def continuous_submodule : submodule R (α → M) :=
{ carrier := { f : α → M | continuous f },
  smul_mem' := λ c f hf, hf.const_smul c,
  ..continuous_add_subgroup α M }

end subtype

namespace continuous_map
variables {α β : Type*} [topological_space α] [topological_space β]
  {R R₁ : Type*}
  {M : Type*} [topological_space M]
  {M₂ : Type*} [topological_space M₂]

@[to_additive continuous_map.has_vadd]
instance [has_scalar R M] [has_continuous_const_smul R M] : has_scalar R C(α, M) :=
⟨λ r f, ⟨r • f, f.continuous.const_smul r⟩⟩

@[to_additive]
instance [locally_compact_space α] [has_scalar R M] [has_continuous_const_smul R M] :
  has_continuous_const_smul R C(α, M) :=
⟨λ γ, continuous_of_continuous_uncurry _ (continuous_eval'.const_smul γ)⟩

@[to_additive]
instance [locally_compact_space α] [topological_space R] [has_scalar R M]
  [has_continuous_smul R M] : has_continuous_smul R C(α, M) :=
⟨begin
  refine continuous_of_continuous_uncurry _ _,
  have h : continuous (λ x : (R × C(α, M)) × α, x.fst.snd x.snd) :=
    continuous_eval'.comp (continuous_snd.prod_map continuous_id),
  exact (continuous_fst.comp continuous_fst).smul h,
end⟩

@[simp, to_additive, norm_cast]
lemma coe_smul [has_scalar R M] [has_continuous_const_smul R M]
  (c : R) (f : C(α, M)) : ⇑(c • f) = c • f := rfl

@[to_additive]
lemma smul_apply [has_scalar R M] [has_continuous_const_smul R M]
  (c : R) (f : C(α, M)) (a : α) : (c • f) a = c • (f a) :=
rfl

@[simp, to_additive] lemma smul_comp [has_scalar R M] [has_continuous_const_smul R M]
  (r : R) (f : C(β, M)) (g : C(α, β)) :
  (r • f).comp g = r • (f.comp g) :=
rfl

@[to_additive]
instance [has_scalar R M] [has_continuous_const_smul R M]
  [has_scalar R₁ M] [has_continuous_const_smul R₁ M]
  [smul_comm_class R R₁ M] : smul_comm_class R R₁ C(α, M) :=
{ smul_comm := λ _ _ _, ext $ λ _, smul_comm _ _ _ }

instance [has_scalar R M] [has_continuous_const_smul R M]
  [has_scalar R₁ M] [has_continuous_const_smul R₁ M]
  [has_scalar R R₁] [is_scalar_tower R R₁ M] : is_scalar_tower R R₁ C(α, M) :=
{ smul_assoc := λ _ _ _, ext $ λ _, smul_assoc _ _ _ }

instance [has_scalar R M] [has_scalar Rᵐᵒᵖ M] [has_continuous_const_smul R M]
  [is_central_scalar R M] : is_central_scalar R C(α, M) :=
{ op_smul_eq_smul := λ _ _, ext $ λ _, op_smul_eq_smul _ _ }

instance [monoid R] [mul_action R M] [has_continuous_const_smul R M] : mul_action R C(α, M) :=
function.injective.mul_action _ coe_injective coe_smul

instance [monoid R] [add_monoid M] [distrib_mul_action R M]
  [has_continuous_add M] [has_continuous_const_smul R M] :
  distrib_mul_action R C(α, M) :=
function.injective.distrib_mul_action coe_fn_add_monoid_hom coe_injective coe_smul

variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂]
variables [has_continuous_add M] [module R M] [has_continuous_const_smul R M]
variables [has_continuous_add M₂] [module R M₂] [has_continuous_const_smul R M₂]

instance module : module R C(α, M) :=
function.injective.module R coe_fn_add_monoid_hom coe_injective coe_smul

variables (R)

/-- Composition on the left by a continuous linear map, as a `linear_map`.
Similar to `linear_map.comp_left`. -/
@[simps] protected def _root_.continuous_linear_map.comp_left_continuous (α : Type*)
  [topological_space α] (g : M →L[R] M₂) :
  C(α, M) →ₗ[R] C(α, M₂) :=
{ map_smul' := λ c f, ext $ λ x, g.map_smul' c _,
  .. g.to_linear_map.to_add_monoid_hom.comp_left_continuous α g.continuous }

/-- Coercion to a function as a `linear_map`. -/
@[simps]
def coe_fn_linear_map : C(α, M) →ₗ[R] (α → M) :=
{ to_fun := coe_fn,
  map_smul' := coe_smul,
  ..(coe_fn_add_monoid_hom : C(α, M) →+ _) }

end continuous_map

end module_structure

section algebra_structure

/-!
### Algebra structure

In this section we show that continuous functions valued in a topological algebra `A` over a ring
`R` inherit the structure of an algebra. Note that the hypothesis that `A` is a topological algebra
is obtained by requiring that `A` be both a `has_continuous_smul` and a `topological_semiring`.-/

section subtype

variables {α : Type*} [topological_space α]
{R : Type*} [comm_semiring R]
{A : Type*} [topological_space A] [semiring A]
[algebra R A] [topological_semiring A]

/-- The `R`-subalgebra of continuous maps `α → A`. -/
def continuous_subalgebra : subalgebra R (α → A) :=
{ carrier := { f : α → A | continuous f },
  algebra_map_mem' := λ r, (continuous_const : continuous $ λ (x : α), algebra_map R A r),
  ..continuous_subsemiring α A }

end subtype

section continuous_map

variables {α : Type*} [topological_space α]
{R : Type*} [comm_semiring R]
{A : Type*} [topological_space A] [semiring A]
[algebra R A] [topological_semiring A]
{A₂ : Type*} [topological_space A₂] [semiring A₂]
[algebra R A₂] [topological_semiring A₂]

/-- Continuous constant functions as a `ring_hom`. -/
def continuous_map.C : R →+* C(α, A) :=
{ to_fun    := λ c : R, ⟨λ x: α, ((algebra_map R A) c), continuous_const⟩,
  map_one'  := by ext x; exact (algebra_map R A).map_one,
  map_mul'  := λ c₁ c₂, by ext x; exact (algebra_map R A).map_mul _ _,
  map_zero' := by ext x; exact (algebra_map R A).map_zero,
  map_add'  := λ c₁ c₂, by ext x; exact (algebra_map R A).map_add _ _ }

@[simp] lemma continuous_map.C_apply (r : R) (a : α) : continuous_map.C r a = algebra_map R A r :=
rfl

variables [has_continuous_const_smul R A] [has_continuous_const_smul R A₂]

instance continuous_map.algebra : algebra R C(α, A) :=
{ to_ring_hom := continuous_map.C,
  commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
  smul_def' := λ c f, by ext x; exact algebra.smul_def' _ _, }

variables (R)

/-- Composition on the left by a (continuous) homomorphism of topological `R`-algebras, as an
`alg_hom`. Similar to `alg_hom.comp_left`. -/
@[simps] protected def alg_hom.comp_left_continuous {α : Type*} [topological_space α]
  (g : A →ₐ[R] A₂) (hg : continuous g) :
  C(α, A) →ₐ[R] C(α, A₂) :=
{ commutes' := λ c, continuous_map.ext $ λ _, g.commutes' _,
  .. g.to_ring_hom.comp_left_continuous α hg }

/-- Coercion to a function as an `alg_hom`. -/
@[simps]
def continuous_map.coe_fn_alg_hom : C(α, A) →ₐ[R] (α → A) :=
{ to_fun := coe_fn,
  commutes' := λ r, rfl,
  -- `..(continuous_map.coe_fn_ring_hom : C(α, A) →+* _)` times out for some reason
  map_zero' := continuous_map.coe_zero,
  map_one' := continuous_map.coe_one,
  map_add' := continuous_map.coe_add,
  map_mul' := continuous_map.coe_mul }

variables {R}

/--
A version of `separates_points` for subalgebras of the continuous functions,
used for stating the Stone-Weierstrass theorem.
-/
abbreviation subalgebra.separates_points (s : subalgebra R C(α, A)) : Prop :=
set.separates_points ((λ f : C(α, A), (f : α → A)) '' (s : set C(α, A)))

lemma subalgebra.separates_points_monotone :
  monotone (λ s : subalgebra R C(α, A), s.separates_points) :=
λ s s' r h x y n,
begin
  obtain ⟨f, m, w⟩ := h n,
  rcases m with ⟨f, ⟨m, rfl⟩⟩,
  exact ⟨_, ⟨f, ⟨r m, rfl⟩⟩, w⟩,
end

@[simp] lemma algebra_map_apply (k : R) (a : α) :
  algebra_map R C(α, A) k a = k • 1 :=
by { rw algebra.algebra_map_eq_smul_one, refl, }

variables {𝕜 : Type*} [topological_space 𝕜]

/--
A set of continuous maps "separates points strongly"
if for each pair of distinct points there is a function with specified values on them.

We give a slightly unusual formulation, where the specified values are given by some
function `v`, and we ask `f x = v x ∧ f y = v y`. This avoids needing a hypothesis `x ≠ y`.

In fact, this definition would work perfectly well for a set of non-continuous functions,
but as the only current use case is in the Stone-Weierstrass theorem,
writing it this way avoids having to deal with casts inside the set.
(This may need to change if we do Stone-Weierstrass on non-compact spaces,
where the functions would be continuous functions vanishing at infinity.)
-/
def set.separates_points_strongly (s : set C(α, 𝕜)) : Prop :=
∀ (v : α → 𝕜) (x y : α), ∃ f : s, (f x : 𝕜) = v x ∧ f y = v y

variables [field 𝕜] [topological_ring 𝕜]

/--
Working in continuous functions into a topological field,
a subalgebra of functions that separates points also separates points strongly.

By the hypothesis, we can find a function `f` so `f x ≠ f y`.
By an affine transformation in the field we can arrange so that `f x = a` and `f x = b`.
-/
lemma subalgebra.separates_points.strongly {s : subalgebra 𝕜 C(α, 𝕜)} (h : s.separates_points) :
  (s : set C(α, 𝕜)).separates_points_strongly :=
λ v x y,
begin
  by_cases n : x = y,
  { subst n,
    use ((v x) • 1 : C(α, 𝕜)),
    { apply s.smul_mem,
      apply s.one_mem, },
    { simp [coe_fn_coe_base'] }, },
  obtain ⟨f, ⟨f, ⟨m, rfl⟩⟩, w⟩ := h n,
  replace w : f x - f y ≠ 0 := sub_ne_zero_of_ne w,
  let a := v x,
  let b := v y,
  let f' := ((b - a) * (f x - f y)⁻¹) • (continuous_map.C (f x) - f) + continuous_map.C a,
  refine ⟨⟨f', _⟩, _, _⟩,
  { simp only [f', set_like.mem_coe, subalgebra.mem_to_submodule],
    -- TODO should there be a tactic for this?
    -- We could add an attribute `@[subobject_mem]`, and a tactic
    -- ``def subobject_mem := `[solve_by_elim with subobject_mem { max_depth := 10 }]``
    solve_by_elim
      [subalgebra.add_mem, subalgebra.smul_mem, subalgebra.sub_mem, subalgebra.algebra_map_mem]
      { max_depth := 6 }, },
  { simp [f', coe_fn_coe_base'], },
  { simp [f', coe_fn_coe_base', inv_mul_cancel_right₀ w], },
end

end continuous_map

-- TODO[gh-6025]: make this an instance once safe to do so
lemma continuous_map.subsingleton_subalgebra (α : Type*) [topological_space α]
  (R : Type*) [comm_semiring R] [topological_space R] [topological_semiring R]
  [subsingleton α] : subsingleton (subalgebra R C(α, R)) :=
begin
  fsplit,
  intros s₁ s₂,
  by_cases n : nonempty α,
  { obtain ⟨x⟩ := n,
    ext f,
    have h : f = algebra_map R C(α, R) (f x),
    { ext x', simp only [mul_one, algebra.id.smul_eq_mul, algebra_map_apply], congr, },
    rw h,
    simp only [subalgebra.algebra_map_mem], },
  { ext f,
    have h : f = 0,
    { ext x', exact false.elim (n ⟨x'⟩), },
    subst h,
    simp only [subalgebra.zero_mem], },
end

end algebra_structure

section module_over_continuous_functions

/-!
### Structure as module over scalar functions

If `M` is a module over `R`, then we show that the space of continuous functions from `α` to `M`
is naturally a module over the ring of continuous functions from `α` to `R`. -/

namespace continuous_map

instance has_scalar' {α : Type*} [topological_space α]
  {R : Type*} [semiring R] [topological_space R]
  {M : Type*} [topological_space M] [add_comm_monoid M]
  [module R M] [has_continuous_smul R M] :
  has_scalar C(α, R) C(α, M) :=
⟨λ f g, ⟨λ x, (f x) • (g x), (continuous.smul f.2 g.2)⟩⟩

instance module' {α : Type*} [topological_space α]
  (R : Type*) [ring R] [topological_space R] [topological_ring R]
  (M : Type*) [topological_space M] [add_comm_monoid M] [has_continuous_add M]
  [module R M] [has_continuous_smul R M] :
  module C(α, R) C(α, M) :=
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul (c₁ x) (c₂ x) (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul (c₁ x) (c₂ x) (f x),
  one_smul := λ f, by ext x; exact one_smul R (f x),
  zero_smul := λ f, by ext x; exact zero_smul _ _,
  smul_zero := λ r, by ext x; exact smul_zero _, }

end continuous_map

end module_over_continuous_functions

/-!
We now provide formulas for `f ⊓ g` and `f ⊔ g`, where `f g : C(α, β)`,
in terms of `continuous_map.abs`.
-/

section
variables {R : Type*} [linear_ordered_field R]

-- TODO:
-- This lemma (and the next) could go all the way back in `algebra.order.field`,
-- except that it is tedious to prove without tactics.
-- Rather than stranding it at some intermediate location,
-- it's here, immediately prior to the point of use.
lemma min_eq_half_add_sub_abs_sub {x y : R} : min x y = 2⁻¹ * (x + y - |x - y|) :=
by cases le_total x y with h h; field_simp [h, abs_of_nonneg, abs_of_nonpos, mul_two]; abel

lemma max_eq_half_add_add_abs_sub {x y : R} : max x y = 2⁻¹ * (x + y + |x - y|) :=
by cases le_total x y with h h; field_simp [h, abs_of_nonneg, abs_of_nonpos, mul_two]; abel

end

namespace continuous_map

section lattice
variables {α : Type*} [topological_space α]
variables {β : Type*} [linear_ordered_field β] [topological_space β]
  [order_topology β] [topological_ring β]

lemma inf_eq (f g : C(α, β)) : f ⊓ g = (2⁻¹ : β) • (f + g - |f - g|) :=
ext (λ x, by simpa using min_eq_half_add_sub_abs_sub)

-- Not sure why this is grosser than `inf_eq`:
lemma sup_eq (f g : C(α, β)) : f ⊔ g = (2⁻¹ : β) • (f + g + |f - g|) :=
ext (λ x, by simpa [mul_add] using @max_eq_half_add_add_abs_sub _ _ (f x) (g x))

end lattice

end continuous_map


import data.int.basic
import data.list.basic
import tactic

inductive min_heap (α : Type) [linear_order α] : Type
| nil  :                           min_heap
| node : min_heap → α → min_heap → min_heap

namespace min_heap
  -- instance {α : Type} [linear_order α] : has_emptyc (min_heap α) := ⟨empty⟩

  structure nonempty {α : Type} [linear_order α] (h : min_heap α) :=
    mk :: (root : {a // ∃ l r, h = node l a r})

  section
    variables {α : Type}
    variables [inhabited α] [linear_order α] [has_to_string α]

    notation `∅` := min_heap.nil

    def all_nodes : min_heap α → list α
    | ∅            := []
    | (node l a r) := (all_nodes l) ++ [a] ++ (all_nodes r)

    def print : min_heap α → string
    | ∅            := ""
    | (node l a r) := "(" ++ (print l) ++ " " ++ (to_string a) ++ " " ++ (print r) ++ ")"

    def is_empty : min_heap α → bool
    | ∅ := tt
    | _ := ff

    def size : min_heap α → nat
    | ∅            := 0
    | (node l a r) := size l + 1 + size r

    def get_min : min_heap α → α
    | ∅            := default α
    | (node _ a _) := a

    -- (TODO: fix it)
    def get_last : min_heap α → α
    | ∅            := default α
    | (node ∅ a ∅) := a
    | (node l a ∅) := get_last l
    | (node l a r) := get_last r

    -- (TODO: fix it)
    def remove_last : min_heap α → min_heap α
    | ∅            := ∅
    | (node ∅ a ∅) := ∅
    | (node l a ∅) := node (remove_last l) a ∅
    | (node l a r) := node l a (remove_last r)

    lemma size_remove_last (h : min_heap α) : h.remove_last.size = h.size - 1 := by
    { induction h with l a r hl hr,
      refl,
      cases l with l₁ a₁ r₁,
      { cases r with l₂ a₂ r₂,
        { simp [remove_last, size] },
        { simp [remove_last, size, hr], ring_nf } },
      { cases r with l₂ a₂ r₂,
        { simp [remove_last, size, hl], ring_nf },
        { simp [remove_last, size, hl, hr], ring_nf } } }

    def fix_min_heap : min_heap α → min_heap α
    | ∅ := ∅
    | (node ∅ a ∅) := node ∅ a ∅
    | (node (node l₁ a₁ r₁) a ∅) :=
      if a₁ < a then node (fix_min_heap $ node l₁ a r₁) a₁ ∅
      else           node (node l₁ a₁ r₁) a ∅
    | (node ∅ a (node l₂ a₂ r₂)) :=
      if a₂ < a then node ∅ a₂ (fix_min_heap $ node l₂ a r₂)
      else           node ∅ a (node l₂ a₂ r₂)
    | (node (node l₁ a₁ r₁) a (node l₂ a₂ r₂)) :=
      if a₁ < a₂ then
      ( if a₁ < a then node (fix_min_heap $ node l₁ a r₁) a₁ (node l₂ a₂ r₂)
        else           node (node l₁ a₁ r₁) a (node l₂ a₂ r₂) )
      else
      ( if a₂ < a then node (node l₁ a₁ r₁) a₂ (fix_min_heap $ node l₂ a r₂)
        else           node (node l₁ a₁ r₁) a (node l₂ a₂ r₂) )

    lemma size_fix_min_heap : ∀ h : min_heap α, h.fix_min_heap.size = h.size
    | ∅ := by { simp [fix_min_heap, size] }
    | (node ∅ a ∅) := by { simp [fix_min_heap, size] }
    | (node (node l₁ a₁ r₁) a ∅) := by
      { simp [fix_min_heap, size], split_ifs;
        simp [fix_min_heap, size, size_fix_min_heap (node l₁ a r₁)] }
    | (node ∅ a (node l₂ a₂ r₂)) := by
      { simp [fix_min_heap, size], split_ifs;
        simp [fix_min_heap, size, size_fix_min_heap (node l₂ a r₂)] }
    | (node (node l₁ a₁ r₁) a (node l₂ a₂ r₂)) := by
      { simp [fix_min_heap, size], split_ifs;
        simp [fix_min_heap, size],
        { simp [fix_min_heap, size, size_fix_min_heap (node l₁ a r₁)] },
        { simp [fix_min_heap, size, size_fix_min_heap (node l₂ a r₂)] } }

    def remove_min : min_heap α → min_heap α
    | ∅              := ∅
    | h@(node l a r) := fix_min_heap ∘ remove_last $ node l (get_last h) r

    lemma size_remove_min : ∀ h : min_heap α, h.remove_min.size = h.size - 1 := by
    { intros h, induction h with l a r hl hr,
      { simp [size, remove_min, get_last, remove_last] },
      { simp [size, remove_min, get_last, remove_last, size_remove_last, size_fix_min_heap] } }

    def init_min_heap : min_heap α → min_heap α
    | ∅ := ∅
    | (node l a r) := fix_min_heap $ node (init_min_heap l) a (init_min_heap r)

    open nat

    -- Greatest integer power of 2 less or equal than n
    def gpow2 : nat → nat
    | 0 := 0
    | 1 := 1
    | (succ (succ a)) :=
      have a / 2 + 1 < a + 2 := succ_lt_succ_iff.mpr (lt_succ_of_le (nat.div_le_self a 2)),
      gpow2 (a / 2 + 1) * 2

    lemma gpow2_le : ∀ n : nat, gpow2 n ≤ n
    | 0 := by { unfold gpow2 }
    | 1 := by { unfold gpow2 }
    | (succ (succ a)) :=
      have a / 2 + 1 < a + 2 := succ_lt_succ_iff.mpr (lt_succ_of_le (nat.div_le_self a 2)),
      have ih : gpow2 (a / 2 + 1) ≤ a / 2 + 1 :=
      by { exact gpow2_le (a / 2 + 1) },
      by { unfold gpow2,
           suffices : (a / 2 + 1) * 2 ≤ a + 2,
           { have h := mul_le_mul_right' (gpow2_le (a / 2 + 1)) 2,
             exact le_trans h this },
           rw [add_mul, one_mul],
           apply lt_succ_of_le,
           apply lt_succ_of_le,
           exact div_mul_le_self a 2 }

    lemma zero_lt_gpow2 : ∀ n : nat, 0 < n → 0 < gpow2 n
    | 0 := by { unfold gpow2, exact id }
    | 1 := by { unfold gpow2, exact id }
    | (succ (succ a)) := λ _,
      have a / 2 + 1 < a + 2 := succ_lt_succ_iff.mpr (lt_succ_of_le (nat.div_le_self a 2)),
      have ih : 0 < gpow2 (a / 2 + 1) :=
      by { exact zero_lt_gpow2 (a / 2 + 1) (zero_lt_succ _), },
      by { unfold gpow2,
           rw mul_two, exact add_pos ih ih }

    open list

    def from_list : list α → min_heap α
    | [] := ∅
    | [a] := node ∅ a ∅
    | ls'@(a :: (b :: ls)) :=
      let l := gpow2 (length ls') in
      have h₁ : gpow2 (length ls') - 1 < length ls' := by
      { have := gpow2_le (length (a :: b :: ls)),
        cases gpow2 (a :: b :: ls).length,
        { simp }, { exact this } },
      have h₂ : length ls' - gpow2 (length ls') < length ls' := by
      { suffices : 0 < gpow2 (length ls + 2), { refine nat.sub_lt _ this, simp },
        exact zero_lt_gpow2 (length ls + 2) (zero_lt_succ _) },
      node (from_list $ take (l - 1) ls') (ls'.nth_le (l - 1) h₁) (from_list $ drop l ls')
    using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf length⟩] }

  end

end min_heap

-- Heapsort
section
  variables {α : Type}
  variables [inhabited α] [linear_order α] [has_to_string α]

  def extract_heap : min_heap α → list α
  | min_heap.nil := []
  | hp@(min_heap.node l a r) :=
    have hp.remove_min.size < (l.node a r).size := by
    { have := min_heap.size_remove_min (min_heap.node l a r),
      simp [min_heap.size] at *,
      rw this, simp },
    hp.get_min :: extract_heap hp.remove_min
  using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf min_heap.size⟩] }

  def heapsort (ls : list α) : list α :=
    extract_heap ∘ min_heap.init_min_heap ∘ min_heap.from_list $ ls

  #eval heapsort $ [1, 4, 7, 4, 2, 1, 8, 9]

end


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import algebra.order.floor
import topology.algebra.ordered.basic

/-!
# Topological facts about `int.floor`, `int.ceil` and `int.fract`

This file proves statements about limits and continuity of functions involving `floor`, `ceil` and
`fract`.

## Main declarations

* `tendsto_floor_at_top`, `tendsto_floor_at_bot`, `tendsto_ceil_at_top`, `tendsto_ceil_at_bot`:
  `int.floor` and `int.ceil` tend to +-∞ in +-∞.
* `continuous_on_floor`: `int.floor` is continuous on `Ico n (n + 1)`, because constant.
* `continuous_on_ceil`: `int.ceil` is continuous on `Ioc n (n + 1)`, because constant.
* `continuous_on_fract`: `int.fract` is continuous on `Ico n (n + 1)`.
* `continuous_on.comp_fract`: Precomposing a continuous function satisfying `f 0 = f 1` with
  `int.fract` yields another continuous function.
-/

open filter function int set
open_locale topological_space

variables {α : Type*} [linear_ordered_ring α] [floor_ring α]

lemma tendsto_floor_at_top : tendsto (floor : α → ℤ) at_top at_top :=
floor_mono.tendsto_at_top_at_top $ λ b, ⟨(b + 1 : ℤ), by { rw floor_coe, exact (lt_add_one _).le }⟩

lemma tendsto_floor_at_bot : tendsto (floor : α → ℤ) at_bot at_bot :=
floor_mono.tendsto_at_bot_at_bot $ λ b, ⟨b, (floor_coe _).le⟩

lemma tendsto_ceil_at_top : tendsto (ceil : α → ℤ) at_top at_top :=
ceil_mono.tendsto_at_top_at_top $ λ b, ⟨b, (ceil_coe _).ge⟩

lemma tendsto_ceil_at_bot : tendsto (ceil : α → ℤ) at_bot at_bot :=
ceil_mono.tendsto_at_bot_at_bot $ λ b, ⟨(b - 1 : ℤ), by { rw ceil_coe, exact (sub_one_lt _).le }⟩

variables [topological_space α]

lemma continuous_on_floor (n : ℤ) : continuous_on (λ x, floor x : α → α) (Ico n (n+1) : set α) :=
(continuous_on_congr $ floor_eq_on_Ico' n).mpr continuous_on_const

lemma continuous_on_ceil (n : ℤ) : continuous_on (λ x, ceil x : α → α) (Ioc (n-1) n : set α) :=
(continuous_on_congr $ ceil_eq_on_Ioc' n).mpr continuous_on_const

lemma tendsto_floor_right' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[Ici n] n) (𝓝 n) :=
begin
  rw ← nhds_within_Ico_eq_nhds_within_Ici (lt_add_one (n : α)),
  simpa only [floor_coe] using
    (continuous_on_floor n _ (left_mem_Ico.mpr $ lt_add_one (_ : α))).tendsto
end

lemma tendsto_ceil_left' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[Iic n] n) (𝓝 n) :=
begin
  rw ← nhds_within_Ioc_eq_nhds_within_Iic (sub_one_lt (n : α)),
  simpa only [ceil_coe] using
    (continuous_on_ceil _ _ (right_mem_Ioc.mpr $ sub_one_lt (_ : α))).tendsto
end

lemma tendsto_floor_right [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[Ici n] n) (𝓝[Ici n] n) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ (tendsto_floor_right' _)
begin
  refine (eventually_nhds_with_of_forall $ λ x (hx : (n : α) ≤ x), _),
  change _ ≤ _,
  norm_cast,
  convert ← floor_mono hx,
  rw floor_eq_iff,
  exact ⟨le_refl _, lt_add_one _⟩
end

lemma tendsto_ceil_left [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[Iic n] n) (𝓝[Iic n] n) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ (tendsto_ceil_left' _)
begin
  refine (eventually_nhds_with_of_forall $ λ x (hx : x ≤ (n : α)), _),
  change _ ≤ _,
  norm_cast,
  convert ← ceil_mono hx,
  rw ceil_eq_iff,
  exact ⟨sub_one_lt _, le_refl _⟩
end

lemma tendsto_floor_left [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[Iio n] n) (𝓝[Iic (n-1)] (n-1)) :=
begin
  rw ← nhds_within_Ico_eq_nhds_within_Iio (sub_one_lt (n : α)),
  convert (tendsto_nhds_within_congr $ (λ x hx, (floor_eq_on_Ico' (n-1) x hx).symm))
    (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ tendsto_const_nhds
      (eventually_of_forall (λ _, mem_Iic.mpr $ le_refl _)));
  norm_cast <|> apply_instance,
  ring
end

lemma tendsto_ceil_right [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[Ioi n] n) (𝓝[Ici (n+1)] (n+1)) :=
begin
  rw ← nhds_within_Ioc_eq_nhds_within_Ioi (lt_add_one (n : α)),
  convert (tendsto_nhds_within_congr $ (λ x hx, (ceil_eq_on_Ioc' (n+1) x hx).symm))
    (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ tendsto_const_nhds
      (eventually_of_forall (λ _, mem_Ici.mpr $ le_refl _)));
  norm_cast <|> apply_instance,
  ring
end

lemma tendsto_floor_left' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[Iio n] n) (𝓝 (n-1)) :=
begin
  rw ← nhds_within_univ,
  exact tendsto_nhds_within_mono_right (subset_univ _) (tendsto_floor_left n),
end

lemma tendsto_ceil_right' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[Ioi n] n) (𝓝 (n+1)) :=
begin
  rw ← nhds_within_univ,
  exact tendsto_nhds_within_mono_right (subset_univ _) (tendsto_ceil_right n),
end

lemma continuous_on_fract [topological_add_group α] (n : ℤ) :
  continuous_on (fract : α → α) (Ico n (n+1) : set α) :=
continuous_on_id.sub (continuous_on_floor n)

lemma tendsto_fract_left' [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[Iio n] n) (𝓝 1) :=
begin
  convert (tendsto_nhds_within_of_tendsto_nhds tendsto_id).sub (tendsto_floor_left' n);
  [{norm_cast, ring}, apply_instance, apply_instance]
end

lemma tendsto_fract_left [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[Iio n] n) (𝓝[Iio 1] 1) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
  (tendsto_fract_left' _) (eventually_of_forall fract_lt_one)

lemma tendsto_fract_right' [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[Ici n] n) (𝓝 0) :=
begin
  convert (tendsto_nhds_within_of_tendsto_nhds tendsto_id).sub (tendsto_floor_right' n);
  [exact (sub_self _).symm, apply_instance, apply_instance]
end

lemma tendsto_fract_right [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[Ici n] n) (𝓝[Ici 0] 0) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
  (tendsto_fract_right' _) (eventually_of_forall fract_nonneg)

local notation `I` := (Icc 0 1 : set α)

lemma continuous_on.comp_fract' {β γ : Type*} [order_topology α]
  [topological_add_group α] [topological_space β] [topological_space γ] {f : β → α → γ}
  (h : continuous_on (uncurry f) $ (univ : set β).prod I) (hf : ∀ s, f s 0 = f s 1) :
  continuous (λ st : β × α, f st.1 $ fract st.2) :=
begin
  change continuous ((uncurry f) ∘ (prod.map id (fract))),
  rw continuous_iff_continuous_at,
  rintro ⟨s, t⟩,
  by_cases ht : t = floor t,
  { rw ht,
    rw ← continuous_within_at_univ,
    have : (univ : set (β × α)) ⊆ (set.prod univ (Iio $ floor t)) ∪ (set.prod univ (Ici $ floor t)),
    { rintros p -,
      rw ← prod_union,
      exact ⟨true.intro, lt_or_le _ _⟩ },
    refine continuous_within_at.mono _ this,
    refine continuous_within_at.union _ _,
    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
                  nhds_within_univ, id.def, comp_app, prod.map_mk],
      have : (uncurry f) (s, 0) = (uncurry f) (s, (1 : α)),
        by simp [uncurry, hf],
      rw this,
      refine (h _ ⟨true.intro, by exact_mod_cast right_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
      rw [nhds_within_prod_eq, nhds_within_univ],
      rw nhds_within_Icc_eq_nhds_within_Iic (@zero_lt_one α _ _),
      exact tendsto_id.prod_map
        (tendsto_nhds_within_mono_right Iio_subset_Iic_self $ tendsto_fract_left _) },
    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
                  nhds_within_univ, id.def, comp_app, prod.map_mk],
      refine (h _ ⟨true.intro, by exact_mod_cast left_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
      rw [nhds_within_prod_eq, nhds_within_univ,
        nhds_within_Icc_eq_nhds_within_Ici (@zero_lt_one α _ _)],
      exact tendsto_id.prod_map (tendsto_fract_right _) } },
  { have : t ∈ Ioo (floor t : α) ((floor t : α) + 1),
      from ⟨lt_of_le_of_ne (floor_le t) (ne.symm ht), lt_floor_add_one _⟩,
    apply (h ((prod.map _ fract) _) ⟨trivial, ⟨fract_nonneg _, (fract_lt_one _).le⟩⟩).tendsto.comp,
    simp only [nhds_prod_eq, nhds_within_prod_eq, nhds_within_univ, id.def, prod.map_mk],
    exact continuous_at_id.tendsto.prod_map
            (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
              (((continuous_on_fract _ _ (Ioo_subset_Ico_self this)).mono
                  Ioo_subset_Ico_self).continuous_at (Ioo_mem_nhds this.1 this.2))
              (eventually_of_forall (λ x, ⟨fract_nonneg _, (fract_lt_one _).le⟩)) ) }
end

lemma continuous_on.comp_fract {β : Type*} [order_topology α]
  [topological_add_group α] [topological_space β] {f : α → β}
  (h : continuous_on f I) (hf : f 0 = f 1) : continuous (f ∘ fract) :=
begin
  let f' : unit → α → β := λ x y, f y,
  have : continuous_on (uncurry f') ((univ : set unit).prod I),
  { rintros ⟨s, t⟩ ⟨-, ht : t ∈ I⟩,
    simp only [continuous_within_at, uncurry, nhds_within_prod_eq, nhds_within_univ, f'],
    rw tendsto_prod_iff,
    intros W hW,
    specialize h t ht hW,
    rw mem_map_iff_exists_image at h,
    rcases h with ⟨V, hV, hVW⟩,
    rw image_subset_iff at hVW,
    use [univ, univ_mem, V, hV],
    intros x y hx hy,
    exact hVW hy },
  have key : continuous (λ s, ⟨unit.star, s⟩ : α → unit × α) := by continuity,
  exact (this.comp_fract' (λ s, hf)).comp key
end