/-
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
-/
import data.set.lattice
import data.nat.order.basic
import tactic.wlog

/-!
# Set enumeration

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

This file allows enumeration of sets given a choice function.

The definition does not assume `sel` actually is a choice function, i.e. `sel s ∈ s` and
`sel s = none ↔ s = ∅`. These assumptions are added to the lemmas needing them.
-/

noncomputable theory

open function

namespace set

section enumerate
parameters {α : Type*} (sel : set α → option α)

/-- Given a choice function `sel`, enumerates the elements of a set in the order
`a 0 = sel s`, `a 1 = sel (s \ {a 0})`, `a 2 = sel (s \ {a 0, a 1})`, ... and stops when
`sel (s \ {a 0, ..., a n}) = none`. Note that we don't require `sel` to be a choice function. -/
def enumerate : set α → ℕ → option α
| s 0       := sel s
| s (n + 1) := do a ← sel s, enumerate (s \ {a}) n

lemma enumerate_eq_none_of_sel {s : set α} (h : sel s = none) : ∀ {n}, enumerate s n = none
| 0       := by simp [h, enumerate]; refl
| (n + 1) := by simp [h, enumerate]; refl

lemma enumerate_eq_none : ∀ {s n₁ n₂}, enumerate s n₁ = none → n₁ ≤ n₂ → enumerate s n₂ = none
| s 0       m := λ h _, enumerate_eq_none_of_sel h
| s (n + 1) m := λ h hm,
  begin
    cases hs : sel s,
    { exact enumerate_eq_none_of_sel sel hs },
    { cases m,
      case nat.zero
      { have : n + 1 = 0, from nat.eq_zero_of_le_zero hm,
        contradiction },
      case nat.succ : m'
      { simp [hs, enumerate] at h ⊢,
        have hm : n ≤ m', from nat.le_of_succ_le_succ hm,
        exact enumerate_eq_none h hm } }
  end

lemma enumerate_mem (h_sel : ∀ s a, sel s = some a → a ∈ s) :
  ∀ {s n a}, enumerate s n = some a → a ∈ s
| s 0 a     := h_sel s a
| s (n+1) a :=
  begin
    cases h : sel s,
    case none { simp [enumerate_eq_none_of_sel, h] },
    case some : a'
    { simp [enumerate, h],
      exact λ h' : enumerate _ (s \ {a'}) n = some a,
        have a ∈ s \ {a'}, from enumerate_mem h',
        this.left }
  end

lemma enumerate_inj {n₁ n₂ : ℕ} {a : α} {s : set α} (h_sel : ∀ s a, sel s = some a → a ∈ s)
  (h₁ : enumerate s n₁ = some a) (h₂ : enumerate s n₂ = some a) : n₁ = n₂ :=
begin
  wlog hn : n₁ ≤ n₂,
  { cases le_total n₁ n₂ with H H; [skip, symmetry]; apply_assumption; assumption },
  { rcases nat.le.dest hn with ⟨m, rfl⟩, clear hn,
    induction n₁ generalizing s,
    case nat.zero
    { cases m,
      case nat.zero { refl },
      case nat.succ : m
      { have : enumerate sel (s \ {a}) m = some a, { simp [enumerate, *] at * },
        have : a ∈ s \ {a}, from enumerate_mem _ h_sel this,
        by simpa } },
    case nat.succ { cases h : sel s; simp [enumerate, nat.add_succ, add_comm, *] at *; tauto } }
end

end enumerate

end set


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

universe u
variable {α : Type u}

-- TODO: this is necessary additionally to mul_nonneg otherwise the simplifier can not match
lemma zero_le_mul [ordered_semiring α] {a b : α} : 0 ≤ a → 0 ≤ b → 0 ≤ a * b :=
mul_nonneg

section linear_ordered_semiring
variable [linear_ordered_semiring α]

@[simp] lemma mul_le_mul_left {a b c : α} (h : 0 < c) : c * a ≤ c * b ↔ a ≤ b :=
⟨λ h', le_of_mul_le_mul_left h' h, λ h', mul_le_mul_of_nonneg_left h' (le_of_lt h)⟩

@[simp] lemma mul_le_mul_right {a b c : α} (h : 0 < c) : a * c ≤ b * c ↔ a ≤ b :=
⟨λ h', le_of_mul_le_mul_right h' h, λ h', mul_le_mul_of_nonneg_right h' (le_of_lt h)⟩

@[simp] lemma mul_lt_mul_left {a b c : α} (h : 0 < c) : c * a < c * b ↔ a < b :=
⟨lt_imp_lt_of_le_imp_le $ λ h', mul_le_mul_of_nonneg_left h' (le_of_lt h),
 λ h', mul_lt_mul_of_pos_left h' h⟩

@[simp] lemma mul_lt_mul_right {a b c : α} (h : 0 < c) : a * c < b * c ↔ a < b :=
⟨lt_imp_lt_of_le_imp_le $ λ h', mul_le_mul_of_nonneg_right h' (le_of_lt h),
 λ h', mul_lt_mul_of_pos_right h' h⟩

lemma mul_lt_mul'' {a b c d : α} (h1 : a < c) (h2 : b < d) (h3 : 0 ≤ a) (h4 : 0 ≤ b) :
       a * b < c * d :=
(lt_or_eq_of_le h4).elim
  (λ b0, mul_lt_mul h1 (le_of_lt h2) b0 (le_trans h3 (le_of_lt h1)))
  (λ b0, by rw [← b0, mul_zero]; exact
    mul_pos (lt_of_le_of_lt h3 h1) (lt_of_le_of_lt h4 h2))

lemma le_mul_iff_one_le_left {a b : α} (hb : b > 0) : b ≤ a * b ↔ 1 ≤ a :=
suffices 1 * b ≤ a * b ↔ 1 ≤ a, by rwa one_mul at this,
mul_le_mul_right hb

lemma lt_mul_iff_one_lt_left {a b : α} (hb : b > 0) : b < a * b ↔ 1 < a :=
suffices 1 * b < a * b ↔ 1 < a, by rwa one_mul at this,
mul_lt_mul_right hb

lemma le_mul_iff_one_le_right {a b : α} (hb : b > 0) : b ≤ b * a ↔ 1 ≤ a :=
suffices b * 1 ≤ b * a ↔ 1 ≤ a, by rwa mul_one at this,
mul_le_mul_left hb

lemma lt_mul_iff_one_lt_right {a b : α} (hb : b > 0) : b < b * a ↔ 1 < a :=
suffices b * 1 < b * a ↔ 1 < a, by rwa mul_one at this,
mul_lt_mul_left hb

lemma lt_mul_of_gt_one_right' {a b : α} (hb : b > 0) : a > 1 → b < b * a :=
(lt_mul_iff_one_lt_right hb).2

lemma le_mul_of_ge_one_right' {a b : α} (hb : b ≥ 0) (h : a ≥ 1) : b ≤ b * a :=
suffices b * 1 ≤ b * a, by rwa mul_one at this,
mul_le_mul_of_nonneg_left h hb

lemma le_mul_of_ge_one_left' {a b : α} (hb : b ≥ 0) (h : a ≥ 1) : b ≤ a * b :=
suffices 1 * b ≤ a * b, by rwa one_mul at this,
mul_le_mul_of_nonneg_right h hb

theorem mul_nonneg_iff_right_nonneg_of_pos {a b : α} (h : 0 < a) : 0 ≤ b * a ↔ 0 ≤ b :=
⟨assume : 0 ≤ b * a, nonneg_of_mul_nonneg_right this h, assume : 0 ≤ b, mul_nonneg this $ le_of_lt h⟩

lemma bit1_pos {a : α} (h : 0 ≤ a) : 0 < bit1 a :=
lt_add_of_le_of_pos (add_nonneg h h) zero_lt_one

lemma bit1_pos' {a : α} (h : 0 < a) : 0 < bit1 a :=
bit1_pos (le_of_lt h)

lemma lt_add_one (a : α) : a < a + 1 :=
lt_add_of_le_of_pos (le_refl _) zero_lt_one

lemma one_lt_two : 1 < (2 : α) := lt_add_one _

lemma one_lt_mul {a b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
(one_mul (1 : α)) ▸ mul_lt_mul' ha hb zero_le_one (lt_of_lt_of_le zero_lt_one ha)

lemma mul_le_one {a b : α} (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 :=
begin rw ← one_mul (1 : α), apply mul_le_mul; {assumption <|> apply zero_le_one} end

lemma one_lt_mul_of_le_of_lt {a b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
calc 1 = 1 * 1 : by rw one_mul
... < a * b : mul_lt_mul' ha hb zero_le_one (lt_of_lt_of_le zero_lt_one ha)

lemma one_lt_mul_of_lt_of_le {a b : α} (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
calc 1 = 1 * 1 : by rw one_mul
... < a * b : mul_lt_mul ha hb zero_lt_one (le_trans zero_le_one (le_of_lt ha))

lemma mul_le_of_le_one_right {a b : α} (ha : 0 ≤ a) (hb1 : b ≤ 1) : a * b ≤ a :=
calc a * b ≤ a * 1 : mul_le_mul_of_nonneg_left hb1 ha
... = a : mul_one a

lemma mul_le_of_le_one_left {a b : α} (hb : 0 ≤ b) (ha1 : a ≤ 1) : a * b ≤ b :=
calc a * b ≤ 1 * b : mul_le_mul ha1 (le_refl b) hb zero_le_one
... = b : one_mul b

lemma mul_lt_one_of_nonneg_of_lt_one_left {a b : α}
  (ha0 : 0 ≤ a) (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
calc a * b ≤ a : mul_le_of_le_one_right ha0 hb
... < 1 : ha

lemma mul_lt_one_of_nonneg_of_lt_one_right {a b : α}
  (ha : a ≤ 1) (hb0 : 0 ≤ b) (hb : b < 1) : a * b < 1 :=
calc a * b ≤ b : mul_le_of_le_one_left hb0 ha
... < 1 : hb

lemma mul_le_iff_le_one_left {a b : α} (hb : b > 0) : a * b ≤ b ↔ a ≤ 1 :=
⟨ λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_left hb).2 (not_lt_of_ge h)),
  λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_left hb).1 (not_lt_of_ge h)) ⟩

lemma mul_lt_iff_lt_one_left {a b : α} (hb : b > 0) : a * b < b ↔ a < 1 :=
⟨ λ h, lt_of_not_ge (mt (le_mul_iff_one_le_left hb).2 (not_le_of_gt h)),
  λ h, lt_of_not_ge (mt (le_mul_iff_one_le_left hb).1 (not_le_of_gt h)) ⟩

lemma mul_le_iff_le_one_right {a b : α} (hb : b > 0) : b * a ≤ b ↔ a ≤ 1 :=
⟨ λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_right hb).2 (not_lt_of_ge h)),
  λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_right hb).1 (not_lt_of_ge h)) ⟩

lemma mul_lt_iff_lt_one_right {a b : α} (hb : b > 0) : b * a < b ↔ a < 1 :=
⟨ λ h, lt_of_not_ge (mt (le_mul_iff_one_le_right hb).2 (not_le_of_gt h)),
  λ h, lt_of_not_ge (mt (le_mul_iff_one_le_right hb).1 (not_le_of_gt h)) ⟩

end linear_ordered_semiring

section decidable_linear_ordered_semiring
variable [decidable_linear_ordered_semiring α]

@[simp] lemma decidable.mul_le_mul_left {a b c : α} (h : 0 < c) : c * a ≤ c * b ↔ a ≤ b :=
decidable.le_iff_le_iff_lt_iff_lt.2 $ mul_lt_mul_left h

@[simp] lemma decidable.mul_le_mul_right {a b c : α} (h : 0 < c) : a * c ≤ b * c ↔ a ≤ b :=
decidable.le_iff_le_iff_lt_iff_lt.2 $ mul_lt_mul_right h

end decidable_linear_ordered_semiring

instance linear_ordered_semiring.to_no_top_order {α : Type*} [linear_ordered_semiring α] :
  no_top_order α :=
⟨assume a, ⟨a + 1, lt_add_of_pos_right _ zero_lt_one⟩⟩

instance linear_ordered_semiring.to_no_bot_order {α : Type*} [linear_ordered_ring α] :
  no_bot_order α :=
⟨assume a, ⟨a - 1, sub_lt_iff_lt_add.mpr $ lt_add_of_pos_right _ zero_lt_one⟩⟩

instance to_domain [s : linear_ordered_ring α] : domain α :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := @linear_ordered_ring.eq_zero_or_eq_zero_of_mul_eq_zero α s,
  ..s }

section linear_ordered_ring
variable [linear_ordered_ring α]

@[simp] lemma mul_le_mul_left_of_neg {a b c : α} (h : c < 0) : c * a ≤ c * b ↔ b ≤ a :=
⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_left h' h,
  λ h', mul_le_mul_of_nonpos_left h' (le_of_lt h)⟩

@[simp] lemma mul_le_mul_right_of_neg {a b c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a :=
⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_right h' h,
  λ h', mul_le_mul_of_nonpos_right h' (le_of_lt h)⟩

@[simp] lemma mul_lt_mul_left_of_neg {a b c : α} (h : c < 0) : c * a < c * b ↔ b < a :=
lt_iff_lt_of_le_iff_le (mul_le_mul_left_of_neg h)

@[simp] lemma mul_lt_mul_right_of_neg {a b c : α} (h : c < 0) : a * c < b * c ↔ b < a :=
lt_iff_lt_of_le_iff_le (mul_le_mul_right_of_neg h)

lemma sub_one_lt (a : α) : a - 1 < a :=
sub_lt_iff_lt_add.2 (lt_add_one a)

lemma mul_self_pos {a : α} (ha : a ≠ 0) : 0 < a * a :=
by rcases lt_trichotomy a 0 with h|h|h;
   [exact mul_pos_of_neg_of_neg h h, exact (ha h).elim, exact mul_pos h h]

end linear_ordered_ring

set_option old_structure_cmd true
/-- Extend `nonneg_comm_group` to support ordered rings
  specified by their nonnegative elements -/
class nonneg_ring (α : Type*)
  extends ring α, zero_ne_one_class α, nonneg_comm_group α :=
(mul_nonneg : ∀ {a b}, nonneg a → nonneg b → nonneg (a * b))
(mul_pos : ∀ {a b}, pos a → pos b → pos (a * b))

/-- Extend `nonneg_comm_group` to support linearly ordered rings
  specified by their nonnegative elements -/
class linear_nonneg_ring (α : Type*) extends domain α, nonneg_comm_group α :=
(mul_nonneg : ∀ {a b}, nonneg a → nonneg b → nonneg (a * b))
(nonneg_total : ∀ a, nonneg a ∨ nonneg (-a))

namespace nonneg_ring
open nonneg_comm_group
variable [s : nonneg_ring α]

instance to_ordered_ring : ordered_ring α :=
{ le := (≤),
  lt := (<),
  lt_iff_le_not_le := @lt_iff_le_not_le _ _,
  le_refl := @le_refl _ _,
  le_trans := @le_trans _ _,
  le_antisymm := @le_antisymm _ _,
  add_lt_add_left := @add_lt_add_left _ _,
  add_le_add_left := @add_le_add_left _ _,
  mul_nonneg := λ a b, by simp [nonneg_def.symm]; exact mul_nonneg,
  mul_pos := λ a b, by simp [pos_def.symm]; exact mul_pos,
  ..s }

def nonneg_ring.to_linear_nonneg_ring
  (nonneg_total : ∀ a : α, nonneg a ∨ nonneg (-a))
  : linear_nonneg_ring α :=
{ nonneg_total := nonneg_total,
  eq_zero_or_eq_zero_of_mul_eq_zero :=
    suffices ∀ {a} b : α, nonneg a → a * b = 0 → a = 0 ∨ b = 0,
    from λ a b, (nonneg_total a).elim (this b)
      (λ na, by simpa using this b na),
    suffices ∀ {a b : α}, nonneg a → nonneg b → a * b = 0 → a = 0 ∨ b = 0,
    from λ a b na, (nonneg_total b).elim (this na)
      (λ nb, by simpa using this na nb),
    λ a b na nb z, classical.by_cases
      (λ nna : nonneg (-a), or.inl (nonneg_antisymm na nna))
      (λ pa, classical.by_cases
        (λ nnb : nonneg (-b), or.inr (nonneg_antisymm nb nnb))
        (λ pb, absurd z $ ne_of_gt $ pos_def.1 $ mul_pos
          ((pos_iff _ _).2 ⟨na, pa⟩)
          ((pos_iff _ _).2 ⟨nb, pb⟩))),
  ..s }

end nonneg_ring

namespace linear_nonneg_ring
open nonneg_comm_group
variable [s : linear_nonneg_ring α]

instance to_nonneg_ring : nonneg_ring α :=
{ mul_pos := λ a b pa pb,
  let ⟨a1, a2⟩ := (pos_iff α a).1 pa,
      ⟨b1, b2⟩ := (pos_iff α b).1 pb in
  have ab : nonneg (a * b), from mul_nonneg a1 b1,
  (pos_iff α _).2 ⟨ab, λ hn,
    have a * b = 0, from nonneg_antisymm ab hn,
    (eq_zero_or_eq_zero_of_mul_eq_zero _ _ this).elim
      (ne_of_gt (pos_def.1 pa))
      (ne_of_gt (pos_def.1 pb))⟩,
  ..s }

instance to_linear_order : linear_order α :=
{ le := (≤),
  lt := (<),
  lt_iff_le_not_le := @lt_iff_le_not_le _ _,
  le_refl := @le_refl _ _,
  le_trans := @le_trans _ _,
  le_antisymm := @le_antisymm _ _,
  le_total := nonneg_total_iff.1 nonneg_total,
  ..s }

instance to_linear_ordered_ring : linear_ordered_ring α :=
{ le := (≤),
  lt := (<),
  lt_iff_le_not_le := @lt_iff_le_not_le _ _,
  le_refl := @le_refl _ _,
  le_trans := @le_trans _ _,
  le_antisymm := @le_antisymm _ _,
  le_total := @le_total _ _,
  add_lt_add_left := @add_lt_add_left _ _,
  add_le_add_left := @add_le_add_left _ _,
  mul_nonneg := by simp [nonneg_def.symm]; exact @mul_nonneg _ _,
  mul_pos := by simp [pos_def.symm]; exact @nonneg_ring.mul_pos _ _,
  zero_lt_one := lt_of_not_ge $ λ (h : nonneg (0 - 1)), begin
    rw [zero_sub] at h,
    have := mul_nonneg h h, simp at this,
    exact zero_ne_one _ (nonneg_antisymm this h).symm
  end, ..s }

instance to_decidable_linear_ordered_comm_ring
  [decidable_pred (@nonneg α _)]
  [comm : @is_commutative α (*)]
  : decidable_linear_ordered_comm_ring α :=
{ decidable_le := by apply_instance,
  decidable_eq := by apply_instance,
  decidable_lt := by apply_instance,
  mul_comm := is_commutative.comm (*),
  ..@linear_nonneg_ring.to_linear_ordered_ring _ s }

end linear_nonneg_ring

class canonically_ordered_comm_semiring (α : Type*) extends
  canonically_ordered_monoid α, comm_semiring α, zero_ne_one_class α :=
(mul_eq_zero_iff (a b : α) : a * b = 0 ↔ a = 0 ∨ b = 0)

namespace canonically_ordered_semiring
open canonically_ordered_monoid

lemma mul_le_mul [canonically_ordered_comm_semiring α] {a b c d : α} (hab : a ≤ b) (hcd : c ≤ d) :
  a * c ≤ b * d :=
begin
  rcases (le_iff_exists_add _ _).1 hab with ⟨b, rfl⟩,
  rcases (le_iff_exists_add _ _).1 hcd with ⟨d, rfl⟩,
  suffices : a * c ≤ a * c + (a * d + b * c + b * d), by simpa [mul_add, add_mul],
  exact (le_iff_exists_add _ _).2 ⟨_, rfl⟩
end

end canonically_ordered_semiring

instance : canonically_ordered_comm_semiring ℕ :=
{ le_iff_exists_add := assume a b,
  ⟨assume h, let ⟨c, hc⟩ := nat.le.dest h in ⟨c, hc.symm⟩,
    assume ⟨c, hc⟩, hc.symm ▸ nat.le_add_right _ _⟩,
  zero_ne_one       := ne_of_lt zero_lt_one,
  mul_eq_zero_iff   := assume a b,
    iff.intro nat.eq_zero_of_mul_eq_zero (by simp [or_imp_distrib] {contextual := tt}),
  bot               := 0,
  bot_le            := nat.zero_le,
  .. (infer_instance : ordered_comm_monoid ℕ),
  .. (infer_instance : linear_ordered_semiring ℕ),
  .. (infer_instance : comm_semiring ℕ) }

namespace with_top
variables [canonically_ordered_comm_semiring α] [decidable_eq α]

instance : mul_zero_class (with_top α) :=
{ zero := 0,
  mul := λm n, if m = 0 ∨ n = 0 then 0 else m.bind (λa, n.bind $ λb, ↑(a * b)),
  zero_mul := assume a, if_pos $ or.inl rfl,
  mul_zero := assume a, if_pos $ or.inr rfl }

instance : has_one (with_top α) := ⟨↑(1:α)⟩

lemma mul_def {a b : with_top α} :
  a * b = if a = 0 ∨ b = 0 then 0 else a.bind (λa, b.bind $ λb, ↑(a * b)) := rfl

@[simp] theorem top_ne_zero [partial_order α] : ⊤ ≠ (0 : with_top α) .
@[simp] theorem zero_ne_top [partial_order α] : (0 : with_top α) ≠ ⊤ .

@[simp] theorem coe_eq_zero [partial_order α] {a : α} : (a : with_top α) = 0 ↔ a = 0 :=
iff.intro
  (assume h, match a, h with _, rfl := rfl end)
  (assume h, h.symm ▸ rfl)

@[simp] theorem zero_eq_coe [partial_order α] {a : α} : 0 = (a : with_top α) ↔ a = 0 :=
by rw [eq_comm, coe_eq_zero]

@[simp] theorem coe_zero [partial_order α] : ↑(0 : α) = (0 : with_top α) := rfl

@[simp] lemma mul_top {a : with_top α} (h : a ≠ 0) : a * ⊤ = ⊤ :=
by cases a; simp [mul_def, h]; refl

@[simp] lemma top_mul {a : with_top α} (h : a ≠ 0) : ⊤ * a = ⊤ :=
by cases a; simp [mul_def, h]; refl

@[simp] lemma top_mul_top : (⊤ * ⊤ : with_top α) = ⊤ :=
top_mul top_ne_zero

lemma coe_mul {a b : α} : (↑(a * b) : with_top α) = a * b :=
decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha,
decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb,
by simp [*, mul_def]; refl

lemma mul_coe {b : α} (hb : b ≠ 0) : ∀{a : with_top α}, a * b = a.bind (λa:α, ↑(a * b))
| none     := show (if (⊤:with_top α) = 0 ∨ (b:with_top α) = 0 then 0 else ⊤ : with_top α) = ⊤,
    by simp [hb]
| (some a) := show ↑a * ↑b = ↑(a * b), from coe_mul.symm

private lemma comm (a b : with_top α) : a * b = b * a :=
begin
  by_cases ha : a = 0, { simp [ha] },
  by_cases hb : b = 0, { simp [hb] },
  simp [ha, hb, mul_def, option.bind_comm a b, mul_comm]
end

@[simp] lemma mul_eq_top_iff {a b : with_top α} : a * b = ⊤ ↔ (a ≠ 0 ∧ b = ⊤) ∨ (a = ⊤ ∧ b ≠ 0) :=
begin
  have H : ∀x:α, (¬x = 0) ↔ (⊤ : with_top α) * ↑x = ⊤ :=
    λx, ⟨λhx, by simp [top_mul, hx], λhx f, by simpa [f] using hx⟩,
  cases a; cases b; simp [none_eq_top, top_mul, coe_ne_top, some_eq_coe, coe_mul.symm],
  { rw [H b] },
  { rw [H a, comm] }
end

private lemma distrib' (a b c : with_top α) : (a + b) * c = a * c + b * c :=
begin
  cases c,
  { show (a + b) * ⊤ = a * ⊤ + b * ⊤,
    by_cases ha : a = 0; simp [ha] },
  { show (a + b) * c = a * c + b * c,
    by_cases hc : c = 0, { simp [hc] },
    simp [mul_coe hc], cases a; cases b,
    repeat { refl <|> exact congr_arg some (add_mul _ _ _) } }
end

private lemma mul_eq_zero (a b : with_top α) : a * b = 0 ↔ a = 0 ∨ b = 0 :=
by cases a; cases b; dsimp [mul_def]; split_ifs;
  simp [*, none_eq_top, some_eq_coe, canonically_ordered_comm_semiring.mul_eq_zero_iff] at *

private lemma assoc (a b c : with_top α) : (a * b) * c = a * (b * c) :=
begin
  cases a,
  { by_cases hb : b = 0; by_cases hc : c = 0;
      simp [*, none_eq_top, mul_eq_zero b c] },
  cases b,
  { by_cases ha : a = 0; by_cases hc : c = 0;
      simp [*, none_eq_top, some_eq_coe, mul_eq_zero ↑a c] },
  cases c,
  { by_cases ha : a = 0; by_cases hb : b = 0;
      simp [*, none_eq_top, some_eq_coe, mul_eq_zero ↑a ↑b] },
  simp [some_eq_coe, coe_mul.symm, mul_assoc]
end

private lemma one_mul' : ∀a : with_top α, 1 * a = a
| none     := show ((1:α) : with_top α) * ⊤ = ⊤, by simp [-with_bot.coe_one]
| (some a) := show ((1:α) : with_top α) * a = a, by simp [coe_mul.symm, -with_bot.coe_one]

instance [canonically_ordered_comm_semiring α] [decidable_eq α] :
  canonically_ordered_comm_semiring (with_top α) :=
{ one             := (1 : α),
  right_distrib   := distrib',
  left_distrib    := assume a b c, by rw [comm, distrib', comm b, comm c]; refl,
  mul_assoc       := assoc,
  mul_comm        := comm,
  mul_eq_zero_iff := mul_eq_zero,
  one_mul         := one_mul',
  mul_one         := assume a, by rw [comm, one_mul'],
  zero_ne_one     := assume h, @zero_ne_one α _ $ option.some.inj h,
  .. with_top.add_comm_monoid, .. with_top.mul_zero_class, .. with_top.canonically_ordered_monoid }

@[simp] lemma coe_nat : ∀(n : nat), ((n : α) : with_top α) = n
| 0     := rfl
| (n+1) := have (((1 : nat) : α) : with_top α) = ((1 : nat) : with_top α) := rfl,
           by rw [nat.cast_add, coe_add, nat.cast_add, coe_nat n, this]

@[simp] lemma nat_ne_top (n : nat) : (n : with_top α ) ≠ ⊤ :=
by rw [←coe_nat n]; apply coe_ne_top

@[simp] lemma top_ne_nat (n : nat) : (⊤ : with_top α) ≠ n :=
by rw [←coe_nat n]; apply top_ne_coe

end with_top


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.fintype.quotient
import model_theory.semantics

/-!
# Quotients of First-Order Structures
This file defines prestructures and quotients of first-order structures.

## Main Definitions
* If `s` is a setoid (equivalence relation) on `M`, a `first_order.language.prestructure s` is the
data for a first-order structure on `M` that will still be a structure when modded out by `s`.
* The structure `first_order.language.quotient_structure s` is the resulting structure on
`quotient s`.

-/

namespace first_order
namespace language

variables (L : language) {M : Type*}
open_locale first_order
open Structure

/-- A prestructure is a first-order structure with a `setoid` equivalence relation on it,
  such that quotienting by that equivalence relation is still a structure. -/
class prestructure (s : setoid M) :=
(to_structure : L.Structure M)
(fun_equiv : ∀{n} {f : L.functions n} (x y : fin n → M),
  x ≈ y → fun_map f x ≈ fun_map f y)
(rel_equiv : ∀{n} {r : L.relations n} (x y : fin n → M) (h : x ≈ y),
  (rel_map r x = rel_map r y))

variables {L} {s : setoid M} [ps : L.prestructure s]

instance quotient_structure :
  L.Structure (quotient s) :=
{ fun_map := λ n f x, quotient.map (@fun_map L M ps.to_structure n f) prestructure.fun_equiv
    (quotient.fin_choice x),
  rel_map := λ n r x, quotient.lift (@rel_map L M ps.to_structure n r) prestructure.rel_equiv
    (quotient.fin_choice x) }

variables [s]
include s

lemma fun_map_quotient_mk {n : ℕ} (f : L.functions n) (x : fin n → M) :
  fun_map f (λ i, ⟦x i⟧) = ⟦@fun_map _ _ ps.to_structure _ f x⟧ :=
begin
  change quotient.map (@fun_map L M ps.to_structure n f) prestructure.fun_equiv
    (quotient.fin_choice _) = _,
  rw [quotient.fin_choice_eq, quotient.map_mk],
end

lemma rel_map_quotient_mk {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r (λ i, ⟦x i⟧) ↔ @rel_map _ _ ps.to_structure _ r x :=
begin
  change quotient.lift (@rel_map L M ps.to_structure n r) prestructure.rel_equiv
    (quotient.fin_choice _) ↔ _,
  rw [quotient.fin_choice_eq, quotient.lift_mk],
end

lemma term.realize_quotient_mk {β : Type*} (t : L.term β) (x : β → M)  :
  t.realize (λ i, ⟦x i⟧) = ⟦@term.realize _ _ ps.to_structure _ x t⟧ :=
begin
  induction t with _ _ _ _ ih,
  { refl },
  { simp only [ih, fun_map_quotient_mk, term.realize] },
end

end language
end first_order


/-
Copyright (c) 2023 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.integral.set_integral
import measure_theory.function.locally_integrable

/-!
# Integrals against peak functions

A sequence of peak functions is a sequence of functions with average one concentrating around
a point `x₀`. Given such a sequence `φₙ`, then `∫ φₙ g` tends to `g x₀` in many situations, with
a whole zoo of possible assumptions on `φₙ` and `g`. This file is devoted to such results.

## Main results

* `tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at`: If a sequence of peak
  functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
  `g` is integrable and continuous at `x₀`, then `∫ φᵢ • g` converges to `g x₀`.
* `tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`:
  If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
  then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
  concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀`
  if `g` is continuous on `s`.

Note that there are related results about convolution with respect to peak functions in the file
`analysis.convolution`, such as `convolution_tendsto_right` there.
-/

open set filter measure_theory measure_theory.measure topological_space metric
open_locale topology ennreal

/-- This lemma exists for finsets, but not for sets currently. porting note: move to
data.set.basic after the port. -/
lemma set.disjoint_sdiff_inter {α : Type*} (s t : set α) : disjoint (s \ t) (s ∩ t) :=
disjoint_of_subset_right (inter_subset_right _ _) disjoint_sdiff_left

open set

variables {α E ι : Type*} {hm : measurable_space α} {μ : measure α}
  [topological_space α] [borel_space α]
  [normed_add_comm_group E] [normed_space ℝ E]
  {g : α → E} {l : filter ι} {x₀ : α} {s : set α} {φ : ι → α → ℝ}

/-- If a sequence of peak functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
`g` is integrable and continuous at `x₀`, then `φᵢ • g` is eventually integrable. -/
lemma integrable_on_peak_smul_of_integrable_on_of_continuous_within_at
  (hs : measurable_set s)
  (hlφ : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 l (s \ u))
  (hiφ : ∀ᶠ i in l, ∫ x in s, φ i x ∂μ = 1)
  (hmg : integrable_on g s μ)
  (hcg : continuous_within_at g s x₀) :
  ∀ᶠ i in l, integrable_on (λ x, φ i x • g x) s μ :=
begin
  obtain ⟨u, u_open, x₀u, hu⟩ : ∃ u, is_open u ∧ x₀ ∈ u ∧ ∀ x ∈ u ∩ s, g x ∈ ball (g x₀) 1,
    from mem_nhds_within.1 (hcg (ball_mem_nhds _ zero_lt_one)),
  filter_upwards [tendsto_uniformly_on_iff.1 (hlφ u u_open x₀u) 1 zero_lt_one, hiφ]
    with i hi h'i,
  have A : integrable_on (λ x, φ i x • g x) (s \ u) μ,
  { apply integrable.smul_of_top_right (hmg.mono (diff_subset _ _) le_rfl),
    apply mem_ℒp_top_of_bound
      ((integrable_of_integral_eq_one h'i).ae_strongly_measurable.mono_set ((diff_subset _ _))) 1,
    filter_upwards [self_mem_ae_restrict (hs.diff u_open.measurable_set)] with x hx,
    simpa only [pi.zero_apply, dist_zero_left] using (hi x hx).le },
  have B : integrable_on (λ x, φ i x • g x) (s ∩ u) μ,
  { apply integrable.smul_of_top_left,
    { exact integrable_on.mono_set (integrable_of_integral_eq_one h'i) (inter_subset_left _ _) },
    { apply mem_ℒp_top_of_bound (hmg.mono_set (inter_subset_left _ _)).ae_strongly_measurable
        (‖g x₀‖ + 1),
      filter_upwards [self_mem_ae_restrict (hs.inter u_open.measurable_set)] with x hx,
      rw inter_comm at hx,
      exact (norm_lt_of_mem_ball (hu x hx)).le } },
  convert A.union B,
  simp only [diff_union_inter],
end

variables [complete_space E]

/-- If a sequence of peak functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
`g` is integrable and continuous at `x₀`, then `∫ φᵢ • g` converges to `x₀`. Auxiliary lemma
where one assumes additionally `g x₀ = 0`. -/
lemma tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at_aux
  (hs : measurable_set s)
  (hnφ : ∀ᶠ i in l, ∀ x ∈ s, 0 ≤ φ i x)
  (hlφ : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 l (s \ u))
  (hiφ : ∀ᶠ i in l, ∫ x in s, φ i x ∂μ = 1)
  (hmg : integrable_on g s μ) (h'g : g x₀ = 0)
  (hcg : continuous_within_at g s x₀) :
  tendsto (λ i : ι, ∫ x in s, φ i x • g x ∂μ) l (𝓝 0) :=
begin
  refine metric.tendsto_nhds.2 (λ ε εpos, _),
  obtain ⟨δ, hδ, δpos⟩ : ∃ δ, δ * ∫ x in s, ‖g x‖ ∂μ + δ < ε ∧ 0 < δ,
  { have A : tendsto (λ δ, δ * ∫ x in s, ‖g x‖ ∂μ + δ) (𝓝[>] 0) (𝓝 (0 * ∫ x in s, ‖g x‖ ∂μ + 0)),
    { apply tendsto.mono_left _ nhds_within_le_nhds,
      exact (tendsto_id.mul tendsto_const_nhds).add tendsto_id },
    rw [zero_mul, zero_add] at A,
    exact (((tendsto_order.1 A).2 ε εpos).and self_mem_nhds_within).exists },
  suffices : ∀ᶠ i in l, ‖∫ x in s, φ i x • g x ∂μ‖ ≤ δ * ∫ x in s, ‖g x‖ ∂μ + δ,
  { filter_upwards [this] with i hi,
    simp only [dist_zero_right],
    exact hi.trans_lt hδ },
  obtain ⟨u, u_open, x₀u, hu⟩ : ∃ u, is_open u ∧ x₀ ∈ u ∧ ∀ x ∈ u ∩ s, g x ∈ ball (g x₀) δ,
    from mem_nhds_within.1 (hcg (ball_mem_nhds _ δpos)),
  filter_upwards [tendsto_uniformly_on_iff.1 (hlφ u u_open x₀u) δ δpos, hiφ, hnφ,
    integrable_on_peak_smul_of_integrable_on_of_continuous_within_at hs hlφ hiφ hmg hcg]
      with i hi h'i hφpos h''i,
  have B : ‖∫ x in s ∩ u, φ i x • g x ∂μ‖ ≤ δ, from calc
    ‖∫ x in s ∩ u, φ i x • g x ∂μ‖ ≤ ∫ x in s ∩ u, ‖φ i x • g x‖ ∂μ :
      norm_integral_le_integral_norm _
    ... ≤ ∫ x in s ∩ u, ‖φ i x‖ * δ ∂μ :
      begin
        refine set_integral_mono_on _ _ (hs.inter u_open.measurable_set) (λ x hx, _),
        { exact integrable_on.mono_set h''i.norm (inter_subset_left _ _) },
        { exact integrable_on.mono_set ((integrable_of_integral_eq_one h'i).norm.mul_const _)
            (inter_subset_left _ _) },
        rw norm_smul,
        apply mul_le_mul_of_nonneg_left _ (norm_nonneg _),
        rw [inter_comm, h'g] at hu,
        exact (mem_ball_zero_iff.1 (hu x hx)).le,
      end
    ... ≤ ∫ x in s, ‖φ i x‖ * δ ∂μ :
      begin
        apply set_integral_mono_set,
        { exact ((integrable_of_integral_eq_one h'i).norm.mul_const _) },
        { exact eventually_of_forall (λ x, mul_nonneg (norm_nonneg _) δpos.le) },
        { apply eventually_of_forall, exact inter_subset_left s u }
      end
    ... = ∫ x in s, φ i x * δ ∂μ :
      begin
        apply set_integral_congr hs (λ x hx, _),
        rw real.norm_of_nonneg (hφpos _ hx),
      end
    ... = δ : by rw [integral_mul_right, h'i, one_mul],
  have C : ‖∫ x in s \ u, φ i x • g x ∂μ‖ ≤ δ * ∫ x in s, ‖g x‖ ∂μ, from calc
    ‖∫ x in s \ u, φ i x • g x ∂μ‖ ≤ ∫ x in s \ u, ‖φ i x • g x‖ ∂μ :
      norm_integral_le_integral_norm _
    ... ≤ ∫ x in s \ u, δ * ‖g x‖ ∂μ :
      begin
        refine set_integral_mono_on _ _ (hs.diff u_open.measurable_set) (λ x hx, _),
        { exact integrable_on.mono_set h''i.norm (diff_subset _ _) },
        { exact integrable_on.mono_set (hmg.norm.const_mul _) (diff_subset _ _) },
        rw norm_smul,
        apply mul_le_mul_of_nonneg_right _ (norm_nonneg _),
        simpa only [pi.zero_apply, dist_zero_left] using (hi x hx).le,
      end
    ... ≤ δ * ∫ x in s, ‖g x‖ ∂μ :
      begin
        rw integral_mul_left,
        apply mul_le_mul_of_nonneg_left (set_integral_mono_set hmg.norm _ _) δpos.le,
        { exact eventually_of_forall (λ x, norm_nonneg _) },
        { apply eventually_of_forall, exact diff_subset s u }
      end,
  calc
  ‖∫ x in s, φ i x • g x ∂μ‖ = ‖∫ x in s \ u, φ i x • g x ∂μ + ∫ x in s ∩ u, φ i x • g x ∂μ‖ :
    begin
      conv_lhs { rw ← diff_union_inter s u },
      rw integral_union (disjoint_sdiff_inter _ _) (hs.inter u_open.measurable_set)
        (h''i.mono_set (diff_subset _ _)) (h''i.mono_set (inter_subset_left _ _))
    end
  ... ≤ ‖∫ x in s \ u, φ i x • g x ∂μ‖ + ‖∫ x in s ∩ u, φ i x • g x ∂μ‖ : norm_add_le _ _
  ... ≤ δ * ∫ x in s, ‖g x‖ ∂μ + δ : add_le_add C B
end

/- If a sequence of peak functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
`g` is integrable and continuous at `x₀`, then `∫ φᵢ • g` converges to `x₀`. -/
lemma tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at
  (hs : measurable_set s) (h's : μ s ≠ ∞)
  (hnφ : ∀ᶠ i in l, ∀ x ∈ s, 0 ≤ φ i x)
  (hlφ : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 l (s \ u))
  (hiφ : (λ i, ∫ x in s, φ i x ∂μ) =ᶠ[l] 1)
  (hmg : integrable_on g s μ)
  (hcg : continuous_within_at g s x₀) :
  tendsto (λ i : ι, ∫ x in s, φ i x • g x ∂μ) l (𝓝 (g x₀)) :=
begin
  let h := g - (λ y, g x₀),
  have A : tendsto (λ i : ι, ∫ x in s, φ i x • h x ∂μ + (∫ x in s, φ i x ∂μ) • g x₀) l
    (𝓝 (0 + (1 : ℝ) • g x₀)),
  { refine tendsto.add _ (tendsto.smul (tendsto_const_nhds.congr' hiφ.symm) tendsto_const_nhds),
    apply tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at_aux
      hs hnφ hlφ hiφ,
    { apply integrable.sub hmg,
      apply integrable_on_const.2,
      simp only [h's.lt_top, or_true] },
    { simp only [h, pi.sub_apply, sub_self] },
    { exact hcg.sub continuous_within_at_const } },
  simp only [one_smul, zero_add] at A,
  refine tendsto.congr' _ A,
  filter_upwards [integrable_on_peak_smul_of_integrable_on_of_continuous_within_at
    hs hlφ hiφ hmg hcg, hiφ] with i hi h'i,
  simp only [h, pi.sub_apply, smul_sub],
  rw [integral_sub hi, integral_smul_const, sub_add_cancel],
  exact integrable.smul_const (integrable_of_integral_eq_one h'i) _,
end

/-- If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀` if `g` is
integrable on `s` and continuous at `x₀`.

Version assuming that `μ` gives positive mass to all neighborhoods of `x₀` within `s`.
For a less precise but more usable version, see
`tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`.
 -/
lemma tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_measure_nhds_within_pos
  [metrizable_space α] [is_locally_finite_measure μ] (hs : is_compact s)
  (hμ : ∀ u, is_open u → x₀ ∈ u → 0 < μ (u ∩ s))
  {c : α → ℝ} (hc : continuous_on c s) (h'c : ∀ y ∈ s, y ≠ x₀ → c y < c x₀)
  (hnc : ∀ x ∈ s, 0 ≤ c x) (hnc₀ : 0 < c x₀) (h₀ : x₀ ∈ s)
  (hmg : integrable_on g s μ)
  (hcg : continuous_within_at g s x₀) :
  tendsto (λ (n : ℕ), (∫ x in s, (c x) ^ n ∂μ)⁻¹ • (∫ x in s, (c x) ^ n • g x ∂μ)) at_top
    (𝓝 (g x₀)) :=
begin
  /- We apply the general result
  `tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at` to the sequence of
  peak functions `φₙ = (c x) ^ n / ∫ (c x) ^ n`. The only nontrivial bit is to check that this
  sequence converges uniformly to zero on any set `s \ u` away from `x₀`. By compactness, the
  function `c` is bounded by `t < c x₀` there. Consider `t' ∈ (t, c x₀)`, and a neighborhood `v`
  of `x₀` where `c x ≥ t'`, by continuity. Then `∫ (c x) ^ n` is bounded below by `t' ^ n μ v`.
  It follows that, on `s \ u`, then `φₙ x ≤ t ^ n / (t' ^ n μ v)`, which tends (exponentially fast)
  to zero with `n`. -/
  let φ : ℕ → α → ℝ := λ n x, (∫ x in s, (c x) ^ n ∂μ)⁻¹ * (c x) ^ n,
  have hnφ : ∀ n, ∀ x ∈ s, 0 ≤ φ n x,
  { assume n x hx,
    apply mul_nonneg (inv_nonneg.2 _) (pow_nonneg (hnc x hx) _),
    exact set_integral_nonneg hs.measurable_set (λ x hx, pow_nonneg (hnc x hx) _) },
  have I : ∀ n, integrable_on (λ x, (c x)^n) s μ :=
    λ n, continuous_on.integrable_on_compact hs (hc.pow n),
  have J : ∀ n, 0 ≤ᵐ[μ.restrict s] λ (x : α), c x ^ n,
  { assume n,
    filter_upwards [ae_restrict_mem hs.measurable_set] with x hx,
    exact pow_nonneg (hnc x hx) n },
  have P : ∀ n, 0 < ∫ x in s, (c x) ^ n ∂μ,
  { assume n,
    refine (set_integral_pos_iff_support_of_nonneg_ae (J n) (I n)).2 _,
    obtain ⟨u, u_open, x₀_u, hu⟩ : ∃ (u : set α), is_open u ∧ x₀ ∈ u ∧ u ∩ s ⊆ c ⁻¹' Ioi 0 :=
      _root_.continuous_on_iff.1 hc x₀ h₀ (Ioi (0 : ℝ)) is_open_Ioi hnc₀,
    apply (hμ u u_open x₀_u).trans_le,
    exact measure_mono (λ x hx, ⟨ne_of_gt (pow_pos (hu hx) _), hx.2⟩) },
  have hiφ : ∀ n, ∫ x in s, φ n x ∂μ = 1 :=
    λ n, by rw [integral_mul_left, inv_mul_cancel (P n).ne'],
  have A : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 at_top (s \ u),
  { assume u u_open x₀u,
    obtain ⟨t, t_pos, tx₀, ht⟩ : ∃ t, 0 ≤ t ∧ t < c x₀ ∧ (∀ x ∈ s \ u, c x ≤ t),
    { rcases eq_empty_or_nonempty (s \ u) with h|h,
      { exact ⟨0, le_rfl, hnc₀,
          by simp only [h, mem_empty_iff_false, is_empty.forall_iff, implies_true_iff]⟩ },
      obtain ⟨x, hx, h'x⟩ : ∃ x ∈ s \ u, ∀ y ∈ s \ u, c y ≤ c x :=
        is_compact.exists_forall_ge (hs.diff u_open) h (hc.mono (diff_subset _ _)),
      refine ⟨c x, hnc x hx.1, h'c x hx.1 _, h'x⟩,
      rintros rfl,
      exact hx.2 x₀u },
    obtain ⟨t', tt', t'x₀⟩ : ∃ t', t < t' ∧ t' < c x₀ := exists_between tx₀,
    have t'_pos : 0 < t' := t_pos.trans_lt tt',
    obtain ⟨v, v_open, x₀_v, hv⟩ : ∃ (v : set α), is_open v ∧ x₀ ∈ v ∧ v ∩ s ⊆ c ⁻¹' Ioi t' :=
      _root_.continuous_on_iff.1 hc x₀ h₀ (Ioi t') is_open_Ioi t'x₀,
    have M : ∀ n, ∀ x ∈ s \ u, φ n x ≤ (μ (v ∩ s)).to_real ⁻¹ * (t / t') ^ n,
    { assume n x hx,
      have B : t' ^ n * (μ (v ∩ s)).to_real ≤ ∫ y in s, (c y) ^ n ∂μ, from calc
        t' ^ n * (μ (v ∩ s)).to_real = ∫ y in v ∩ s, t' ^ n ∂μ :
          by simp only [integral_const, measure.restrict_apply, measurable_set.univ, univ_inter,
              algebra.id.smul_eq_mul, mul_comm]
        ... ≤ ∫ y in v ∩ s, (c y) ^ n ∂μ :
          begin
            apply set_integral_mono_on _ _ (v_open.measurable_set.inter hs.measurable_set) _,
            { apply integrable_on_const.2 (or.inr _),
              exact lt_of_le_of_lt (measure_mono (inter_subset_right _ _)) hs.measure_lt_top },
            { exact (I n).mono (inter_subset_right _ _) le_rfl },
            { assume x hx,
              exact pow_le_pow_of_le_left t'_pos.le (le_of_lt (hv hx)) _ }
          end
        ... ≤ ∫ y in s, (c y) ^ n ∂μ :
          set_integral_mono_set (I n) (J n) (eventually_of_forall (inter_subset_right _ _)),
      simp_rw [φ, ← div_eq_inv_mul, div_pow, div_div],
      apply div_le_div (pow_nonneg t_pos n) _ _ B,
      { exact pow_le_pow_of_le_left (hnc _ hx.1) (ht x hx) _ },
      { apply mul_pos (pow_pos (t_pos.trans_lt tt') _)
          (ennreal.to_real_pos (hμ v v_open x₀_v).ne' _),
        have : μ (v ∩ s) ≤ μ s := measure_mono (inter_subset_right _ _),
        exact ne_of_lt (lt_of_le_of_lt this hs.measure_lt_top) } },
    have N : tendsto (λ n, (μ (v ∩ s)).to_real ⁻¹ * (t / t') ^ n) at_top
      (𝓝 ((μ (v ∩ s)).to_real ⁻¹ * 0)),
    { apply tendsto.mul tendsto_const_nhds _, { apply_instance },
      apply tendsto_pow_at_top_nhds_0_of_lt_1 (div_nonneg t_pos t'_pos.le),
      exact (div_lt_one t'_pos).2 tt' },
    rw mul_zero at N,
    refine tendsto_uniformly_on_iff.2 (λ ε εpos, _),
    filter_upwards [(tendsto_order.1 N).2 ε εpos] with n hn x hx,
    simp only [pi.zero_apply, dist_zero_left, real.norm_of_nonneg (hnφ n x hx.1)],
    exact (M n x hx).trans_lt hn },
  have : tendsto (λ (i : ℕ), ∫ (x : α) in s, φ i x • g x ∂μ) at_top (𝓝 (g x₀)) :=
    tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at hs.measurable_set
      hs.measure_lt_top.ne (eventually_of_forall hnφ) A (eventually_of_forall hiφ) hmg hcg,
  convert this,
  simp_rw [← smul_smul, integral_smul],
end

/-- If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀` if `g` is
integrable on `s` and continuous at `x₀`.

Version assuming that `μ` gives positive mass to all open sets.
For a less precise but more usable version, see
`tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`.
-/
lemma tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_integrable_on
  [metrizable_space α] [is_locally_finite_measure μ] [is_open_pos_measure μ] (hs : is_compact s)
  {c : α → ℝ} (hc : continuous_on c s) (h'c : ∀ y ∈ s, y ≠ x₀ → c y < c x₀)
  (hnc : ∀ x ∈ s, 0 ≤ c x) (hnc₀ : 0 < c x₀) (h₀ : x₀ ∈ closure (interior s))
  (hmg : integrable_on g s μ)
  (hcg : continuous_within_at g s x₀) :
  tendsto (λ (n : ℕ), (∫ x in s, (c x) ^ n ∂μ)⁻¹ • (∫ x in s, (c x) ^ n • g x ∂μ)) at_top
    (𝓝 (g x₀)) :=
begin
  have : x₀ ∈ s,
  { rw ← hs.is_closed.closure_eq, exact closure_mono interior_subset h₀ },
  apply tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_measure_nhds_within_pos
    hs _ hc h'c hnc hnc₀ this hmg hcg,
  assume u u_open x₀_u,
  calc 0 < μ (u ∩ interior s) :
    (u_open.inter is_open_interior).measure_pos μ (_root_.mem_closure_iff.1 h₀ u u_open x₀_u)
  ... ≤ μ (u ∩ s) : measure_mono (inter_subset_inter_right _ interior_subset)
end

/-- If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀` if `g` is
continuous on `s`. -/
lemma tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on
  [metrizable_space α] [is_locally_finite_measure μ] [is_open_pos_measure μ] (hs : is_compact s)
  {c : α → ℝ} (hc : continuous_on c s) (h'c : ∀ y ∈ s, y ≠ x₀ → c y < c x₀)
  (hnc : ∀ x ∈ s, 0 ≤ c x) (hnc₀ : 0 < c x₀) (h₀ : x₀ ∈ closure (interior s))
  (hmg : continuous_on g s) :
  tendsto (λ (n : ℕ), (∫ x in s, (c x) ^ n ∂μ)⁻¹ • (∫ x in s, (c x) ^ n • g x ∂μ)) at_top
    (𝓝 (g x₀)) :=
begin
  have : x₀ ∈ s,
  { rw ← hs.is_closed.closure_eq, exact closure_mono interior_subset h₀ },
  exact tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_integrable_on
    hs hc h'c hnc hnc₀ h₀ (hmg.integrable_on_compact hs) (hmg x₀ this)
end


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Heather Macbeth
-/
import topology.algebra.ordered.basic
import topology.algebra.ordered.left_right

/-!
# Continuity of monotone functions

In this file we prove the following fact: if `f` is a monotone function on a neighborhood of `a`
and the image of this neighborhood is a neighborhood of `f a`, then `f` is continuous at `a`, see
`continuous_at_of_monotone_on_of_image_mem_nhds`, as well as several similar facts.

We also prove that an `order_iso` is continuous.

## Tags

continuous, monotone
-/

open set filter
open_locale topological_space

section linear_order
variables {α β : Type*} [linear_order α] [topological_space α] [order_topology α]
variables [linear_order β] [topological_space β] [order_topology β]

/-- If `f` is a function strictly monotone on a right neighborhood of `a` and the
image of this neighborhood under `f` meets every interval `(f a, b]`, `b > f a`, then `f` is
continuous at `a` from the right.

The assumption `hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b` is required because otherwise the
function `f : ℝ → ℝ` given by `f x = if x ≤ 0 then x else x + 1` would be a counter-example at
`a = 0`. -/
lemma strict_mono_on.continuous_at_right_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≥] a)
  (hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b) :
  continuous_within_at f (Ici a) a :=
begin
  have ha : a ∈ Ici a := left_mem_Ici,
  have has : a ∈ s := mem_of_mem_nhds_within ha hs,
  refine tendsto_order.2 ⟨λ b hb, _, λ b hb, _⟩,
  { filter_upwards [hs, self_mem_nhds_within] with _ hxs hxa
      using hb.trans_le ((h_mono.le_iff_le has hxs).2 hxa) },
  { rcases hfs b hb with ⟨c, hcs, hac, hcb⟩,
    rw [h_mono.lt_iff_lt has hcs] at hac,
    filter_upwards [hs, Ico_mem_nhds_within_Ici (left_mem_Ico.2 hac)],
    rintros x hx ⟨hax, hxc⟩,
    exact ((h_mono.lt_iff_lt hx hcs).2 hxc).trans_le hcb }
end

/-- If `f` is a monotone function on a right neighborhood of `a` and the image of this neighborhood
under `f` meets every interval `(f a, b)`, `b > f a`, then `f` is continuous at `a` from the right.

The assumption `hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioo (f a) b` cannot be replaced by the weaker
assumption `hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b` we use for strictly monotone functions
because otherwise the function `ceil : ℝ → ℤ` would be a counter-example at `a = 0`. -/
lemma continuous_at_right_of_monotone_on_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : monotone_on f s) (hs : s ∈ 𝓝[≥] a)
  (hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioo (f a) b) :
  continuous_within_at f (Ici a) a :=
begin
  have ha : a ∈ Ici a := left_mem_Ici,
  have has : a ∈ s := mem_of_mem_nhds_within ha hs,
  refine tendsto_order.2 ⟨λ b hb, _, λ b hb, _⟩,
  { filter_upwards [hs, self_mem_nhds_within] with _ hxs hxa
      using hb.trans_le (h_mono has hxs hxa) },
  { rcases hfs b hb with ⟨c, hcs, hac, hcb⟩,
    have : a < c, from not_le.1 (λ h, hac.not_le $ h_mono hcs has h),
    filter_upwards [hs, Ico_mem_nhds_within_Ici (left_mem_Ico.2 this)],
    rintros x hx ⟨hax, hxc⟩,
    exact (h_mono hx hcs hxc.le).trans_lt hcb }
end

/-- If a function `f` with a densely ordered codomain is monotone on a right neighborhood of `a` and
the closure of the image of this neighborhood under `f` is a right neighborhood of `f a`, then `f`
is continuous at `a` from the right. -/
lemma continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : monotone_on f s)
  (hs : s ∈ 𝓝[≥] a) (hfs : closure (f '' s) ∈ 𝓝[≥] (f a)) :
  continuous_within_at f (Ici a) a :=
begin
  refine continuous_at_right_of_monotone_on_of_exists_between h_mono hs (λ b hb, _),
  rcases (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hb).1 hfs with ⟨b', ⟨hab', hbb'⟩, hb'⟩,
  rcases exists_between hab' with ⟨c', hc'⟩,
  rcases mem_closure_iff.1 (hb' ⟨hc'.1.le, hc'.2⟩) (Ioo (f a) b') is_open_Ioo hc'
    with ⟨_, hc, ⟨c, hcs, rfl⟩⟩,
  exact ⟨c, hcs, hc.1, hc.2.trans_le hbb'⟩
end

/-- If a function `f` with a densely ordered codomain is monotone on a right neighborhood of `a` and
the image of this neighborhood under `f` is a right neighborhood of `f a`, then `f` is continuous at
`a` from the right. -/
lemma continuous_at_right_of_monotone_on_of_image_mem_nhds_within [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : monotone_on f s) (hs : s ∈ 𝓝[≥] a)
  (hfs : f '' s ∈ 𝓝[≥] (f a)) :
  continuous_within_at f (Ici a) a :=
continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within h_mono hs $
  mem_of_superset hfs subset_closure

/-- If a function `f` with a densely ordered codomain is strictly monotone on a right neighborhood
of `a` and the closure of the image of this neighborhood under `f` is a right neighborhood of `f a`,
then `f` is continuous at `a` from the right. -/
lemma strict_mono_on.continuous_at_right_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≥] a)
  (hfs : closure (f '' s) ∈ 𝓝[≥] (f a)) :
  continuous_within_at f (Ici a) a :=
continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within
  (λ x hx y hy, (h_mono.le_iff_le hx hy).2) hs hfs

/-- If a function `f` with a densely ordered codomain is strictly monotone on a right neighborhood
of `a` and the image of this neighborhood under `f` is a right neighborhood of `f a`, then `f` is
continuous at `a` from the right. -/
lemma strict_mono_on.continuous_at_right_of_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≥] a)
  (hfs : f '' s ∈ 𝓝[≥] (f a)) :
  continuous_within_at f (Ici a) a :=
h_mono.continuous_at_right_of_closure_image_mem_nhds_within hs
  (mem_of_superset hfs subset_closure)

/-- If a function `f` is strictly monotone on a right neighborhood of `a` and the image of this
neighborhood under `f` includes `Ioi (f a)`, then `f` is continuous at `a` from the right. -/
lemma strict_mono_on.continuous_at_right_of_surj_on {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≥] a) (hfs : surj_on f s (Ioi (f a))) :
  continuous_within_at f (Ici a) a :=
h_mono.continuous_at_right_of_exists_between hs $ λ b hb, let ⟨c, hcs, hcb⟩ := hfs hb in
⟨c, hcs, hcb.symm ▸ hb, hcb.le⟩

/-- If `f` is a strictly monotone function on a left neighborhood of `a` and the image of this
neighborhood under `f` meets every interval `[b, f a)`, `b < f a`, then `f` is continuous at `a`
from the left.

The assumption `hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)` is required because otherwise the
function `f : ℝ → ℝ` given by `f x = if x < 0 then x else x + 1` would be a counter-example at
`a = 0`. -/
lemma strict_mono_on.continuous_at_left_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≤] a)
  (hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_exists_between hs $
  λ b hb, let ⟨c, hcs, hcb, hca⟩ := hfs b hb in ⟨c, hcs, hca, hcb⟩

/-- If `f` is a monotone function on a left neighborhood of `a` and the image of this neighborhood
under `f` meets every interval `(b, f a)`, `b < f a`, then `f` is continuous at `a` from the left.

The assumption `hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ioo b (f a)` cannot be replaced by the weaker
assumption `hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)` we use for strictly monotone functions
because otherwise the function `floor : ℝ → ℤ` would be a counter-example at `a = 0`. -/
lemma continuous_at_left_of_monotone_on_of_exists_between {f : α → β} {s : set α} {a : α}
  (hf : monotone_on f s) (hs : s ∈ 𝓝[≤] a)
  (hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ioo b (f a)) :
  continuous_within_at f (Iic a) a :=
@continuous_at_right_of_monotone_on_of_exists_between (order_dual α) (order_dual β) _ _ _ _ _ _
  f s a hf.dual hs $
  λ b hb, let ⟨c, hcs, hcb, hca⟩ := hfs b hb in ⟨c, hcs, hca, hcb⟩

/-- If a function `f` with a densely ordered codomain is monotone on a left neighborhood of `a` and
the closure of the image of this neighborhood under `f` is a left neighborhood of `f a`, then `f` is
continuous at `a` from the left -/
lemma continuous_at_left_of_monotone_on_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (hf : monotone_on f s)
  (hs : s ∈ 𝓝[≤] a) (hfs : closure (f '' s) ∈ 𝓝[≤] (f a)) :
  continuous_within_at f (Iic a) a :=
@continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within (order_dual α) (order_dual β)
  _ _ _ _ _ _ _ f s a hf.dual hs hfs

/-- If a function `f` with a densely ordered codomain is monotone on a left neighborhood of `a` and
the image of this neighborhood under `f` is a left neighborhood of `f a`, then `f` is continuous at
`a` from the left. -/
lemma continuous_at_left_of_monotone_on_of_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : monotone_on f s)
  (hs : s ∈ 𝓝[≤] a) (hfs : f '' s ∈ 𝓝[≤] (f a)) :
  continuous_within_at f (Iic a) a :=
continuous_at_left_of_monotone_on_of_closure_image_mem_nhds_within h_mono hs
  (mem_of_superset hfs subset_closure)

/-- If a function `f` with a densely ordered codomain is strictly monotone on a left neighborhood of
`a` and the closure of the image of this neighborhood under `f` is a left neighborhood of `f a`,
then `f` is continuous at `a` from the left. -/
lemma strict_mono_on.continuous_at_left_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≤] a)
  (hfs : closure (f '' s) ∈ 𝓝[≤] (f a)) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_closure_image_mem_nhds_within hs hfs

/-- If a function `f` with a densely ordered codomain is strictly monotone on a left neighborhood of
`a` and the image of this neighborhood under `f` is a left neighborhood of `f a`, then `f` is
continuous at `a` from the left. -/
lemma strict_mono_on.continuous_at_left_of_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≤] a)
  (hfs : f '' s ∈ 𝓝[≤] (f a)) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_image_mem_nhds_within hs hfs

/-- If a function `f` is strictly monotone on a left neighborhood of `a` and the image of this
neighborhood under `f` includes `Iio (f a)`, then `f` is continuous at `a` from the left. -/
lemma strict_mono_on.continuous_at_left_of_surj_on {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[≤] a) (hfs : surj_on f s (Iio (f a))) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_surj_on hs hfs

/-- If a function `f` is strictly monotone on a neighborhood of `a` and the image of this
neighborhood under `f` meets every interval `[b, f a)`, `b < f a`, and every interval
`(f a, b]`, `b > f a`, then `f` is continuous at `a`. -/
lemma strict_mono_on.continuous_at_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝 a)
  (hfs_l : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)) (hfs_r : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨h_mono.continuous_at_left_of_exists_between (mem_nhds_within_of_mem_nhds hs) hfs_l,
   h_mono.continuous_at_right_of_exists_between (mem_nhds_within_of_mem_nhds hs) hfs_r⟩

/-- If a function `f` with a densely ordered codomain is strictly monotone on a neighborhood of `a`
and the closure of the image of this neighborhood under `f` is a neighborhood of `f a`, then `f` is
continuous at `a`. -/
lemma strict_mono_on.continuous_at_of_closure_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝 a)
  (hfs : closure (f '' s) ∈ 𝓝 (f a)) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨h_mono.continuous_at_left_of_closure_image_mem_nhds_within (mem_nhds_within_of_mem_nhds hs)
     (mem_nhds_within_of_mem_nhds hfs),
   h_mono.continuous_at_right_of_closure_image_mem_nhds_within (mem_nhds_within_of_mem_nhds hs)
     (mem_nhds_within_of_mem_nhds hfs)⟩

/-- If a function `f` with a densely ordered codomain is strictly monotone on a neighborhood of `a`
and the image of this set under `f` is a neighborhood of `f a`, then `f` is continuous at `a`. -/
lemma strict_mono_on.continuous_at_of_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝 a) (hfs : f '' s ∈ 𝓝 (f a)) :
  continuous_at f a :=
h_mono.continuous_at_of_closure_image_mem_nhds hs (mem_of_superset hfs subset_closure)

/-- If `f` is a monotone function on a neighborhood of `a` and the image of this neighborhood under
`f` meets every interval `(b, f a)`, `b < f a`, and every interval `(f a, b)`, `b > f a`, then `f`
is continuous at `a`. -/
lemma continuous_at_of_monotone_on_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : monotone_on f s) (hs : s ∈ 𝓝 a)
  (hfs_l : ∀ b < f a, ∃ c ∈ s, f c ∈ Ioo b (f a)) (hfs_r : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioo (f a) b) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨continuous_at_left_of_monotone_on_of_exists_between h_mono
     (mem_nhds_within_of_mem_nhds hs) hfs_l,
   continuous_at_right_of_monotone_on_of_exists_between h_mono
     (mem_nhds_within_of_mem_nhds hs) hfs_r⟩

/-- If a function `f` with a densely ordered codomain is monotone on a neighborhood of `a` and the
closure of the image of this neighborhood under `f` is a neighborhood of `f a`, then `f` is
continuous at `a`. -/
lemma continuous_at_of_monotone_on_of_closure_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : monotone_on f s) (hs : s ∈ 𝓝 a)
  (hfs : closure (f '' s) ∈ 𝓝 (f a)) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨continuous_at_left_of_monotone_on_of_closure_image_mem_nhds_within h_mono
     (mem_nhds_within_of_mem_nhds hs) (mem_nhds_within_of_mem_nhds hfs),
   continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within h_mono
     (mem_nhds_within_of_mem_nhds hs) (mem_nhds_within_of_mem_nhds hfs)⟩

/-- If a function `f` with a densely ordered codomain is monotone on a neighborhood of `a` and the
image of this neighborhood under `f` is a neighborhood of `f a`, then `f` is continuous at `a`. -/
lemma continuous_at_of_monotone_on_of_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : monotone_on f s) (hs : s ∈ 𝓝 a)
  (hfs : f '' s ∈ 𝓝 (f a)) :
  continuous_at f a :=
continuous_at_of_monotone_on_of_closure_image_mem_nhds h_mono hs
  (mem_of_superset hfs subset_closure)

/-- A monotone function with densely ordered codomain and a dense range is continuous. -/
lemma monotone.continuous_of_dense_range [densely_ordered β] {f : α → β}
  (h_mono : monotone f) (h_dense : dense_range f) :
  continuous f :=
continuous_iff_continuous_at.mpr $ λ a,
  continuous_at_of_monotone_on_of_closure_image_mem_nhds (λ x hx y hy hxy, h_mono hxy)
    univ_mem $ by simp only [image_univ, h_dense.closure_eq, univ_mem]

/-- A monotone surjective function with a densely ordered codomain is continuous. -/
lemma monotone.continuous_of_surjective [densely_ordered β] {f : α → β} (h_mono : monotone f)
  (h_surj : function.surjective f) :
  continuous f :=
h_mono.continuous_of_dense_range h_surj.dense_range

end linear_order

/-!
### Continuity of order isomorphisms

In this section we prove that an `order_iso` is continuous, hence it is a `homeomorph`. We prove
this for an `order_iso` between to partial orders with order topology.
-/

namespace order_iso

variables {α β : Type*} [partial_order α] [partial_order β] [topological_space α]
  [topological_space β] [order_topology α] [order_topology β]

protected lemma continuous (e : α ≃o β) : continuous e :=
begin
  rw [‹order_topology β›.topology_eq_generate_intervals],
  refine continuous_generated_from (λ s hs, _),
  rcases hs with ⟨a, rfl|rfl⟩,
  { rw e.preimage_Ioi, apply is_open_lt' },
  { rw e.preimage_Iio, apply is_open_gt' }
end

/-- An order isomorphism between two linear order `order_topology` spaces is a homeomorphism. -/
def to_homeomorph (e : α ≃o β) : α ≃ₜ β :=
{ continuous_to_fun := e.continuous,
  continuous_inv_fun := e.symm.continuous,
  .. e }

@[simp] lemma coe_to_homeomorph (e : α ≃o β) : ⇑e.to_homeomorph = e := rfl
@[simp] lemma coe_to_homeomorph_symm (e : α ≃o β) : ⇑e.to_homeomorph.symm = e.symm := rfl

end order_iso


/-
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.multiset.powerset

/-!
# The antidiagonal on a multiset.

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

The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
such that `t₁ + t₂ = s`. These pairs are counted with multiplicities.
-/

namespace multiset
open list

variables {α β : Type*}

/-- The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
    such that `t₁ + t₂ = s`. These pairs are counted with multiplicities. -/
def antidiagonal (s : multiset α) : multiset (multiset α × multiset α) :=
quot.lift_on s
  (λ l, (revzip (powerset_aux l) : multiset (multiset α × multiset α)))
  (λ l₁ l₂ h, quot.sound (revzip_powerset_aux_perm h))

theorem antidiagonal_coe (l : list α) :
  @antidiagonal α l = revzip (powerset_aux l) := rfl

@[simp] theorem antidiagonal_coe' (l : list α) :
  @antidiagonal α l = revzip (powerset_aux' l) :=
quot.sound revzip_powerset_aux_perm_aux'

/-- A pair `(t₁, t₂)` of multisets is contained in `antidiagonal s`
    if and only if `t₁ + t₂ = s`. -/
@[simp] theorem mem_antidiagonal {s : multiset α} {x : multiset α × multiset α} :
  x ∈ antidiagonal s ↔ x.1 + x.2 = s :=
quotient.induction_on s $ λ l, begin
  simp [antidiagonal_coe], refine ⟨λ h, revzip_powerset_aux h, λ h, _⟩,
  haveI := classical.dec_eq α,
  simp [revzip_powerset_aux_lemma l revzip_powerset_aux, h.symm],
  cases x with x₁ x₂,
  dsimp only,
  exact ⟨x₁, le_add_right _ _, by rw add_tsub_cancel_left x₁ x₂⟩
end

@[simp] theorem antidiagonal_map_fst (s : multiset α) :
  (antidiagonal s).map prod.fst = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_map_snd (s : multiset α) :
  (antidiagonal s).map prod.snd = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_zero : @antidiagonal α 0 = {(0, 0)} := rfl

@[simp] theorem antidiagonal_cons (a : α) (s) : antidiagonal (a ::ₘ s) =
  map (prod.map id (cons a)) (antidiagonal s) +
  map (prod.map (cons a) id) (antidiagonal s) :=
quotient.induction_on s $ λ l, begin
  simp only [revzip, reverse_append, quot_mk_to_coe, coe_eq_coe, powerset_aux'_cons, cons_coe,
    coe_map, antidiagonal_coe', coe_add],
  rw [← zip_map, ← zip_map, zip_append, (_ : _++_=_)],
  {congr; simp}, {simp}
end

theorem antidiagonal_eq_map_powerset [decidable_eq α] (s : multiset α) :
  s.antidiagonal = s.powerset.map (λ t, (s - t, t)) :=
begin
  induction s using multiset.induction_on with a s hs,
  { simp only [antidiagonal_zero, powerset_zero, zero_tsub, map_singleton] },
  { simp_rw [antidiagonal_cons, powerset_cons, map_add, hs, map_map, function.comp, prod.map_mk,
      id.def, sub_cons, erase_cons_head],
    rw add_comm,
    congr' 1,
    refine multiset.map_congr rfl (λ x hx, _),
    rw cons_sub_of_le _ (mem_powerset.mp hx) }
end

@[simp] theorem card_antidiagonal (s : multiset α) :
  card (antidiagonal s) = 2 ^ card s :=
by have := card_powerset s;
  rwa [← antidiagonal_map_fst, card_map] at this

lemma prod_map_add [comm_semiring β] {s : multiset α} {f g : α → β} :
  prod (s.map (λa, f a + g a)) =
  sum ((antidiagonal s).map (λp, (p.1.map f).prod * (p.2.map g).prod)) :=
begin
  refine s.induction_on _ _,
  { simp },
  { assume a s ih,
    have := @sum_map_mul_left α β _,
    simp [ih, add_mul, mul_comm, mul_left_comm (f a), mul_left_comm (g a), mul_assoc,
      sum_map_mul_left.symm],
    cc },
end

end multiset


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.dual_number
import algebra.quaternion_basis
import data.complex.module
import linear_algebra.clifford_algebra.conjugation
import linear_algebra.clifford_algebra.star
import linear_algebra.quadratic_form.prod

/-!
# Other constructions isomorphic to Clifford Algebras

This file contains isomorphisms showing that other types are equivalent to some `clifford_algebra`.

## Rings

* `clifford_algebra_ring.equiv`: any ring is equivalent to a `clifford_algebra` over a
  zero-dimensional vector space.

## Complex numbers

* `clifford_algebra_complex.equiv`: the `complex` numbers are equivalent as an `ℝ`-algebra to a
  `clifford_algebra` over a one-dimensional vector space with a quadratic form that satisfies
  `Q (ι Q 1) = -1`.
* `clifford_algebra_complex.to_complex`: the forward direction of this equiv
* `clifford_algebra_complex.of_complex`: the reverse direction of this equiv

We show additionally that this equivalence sends `complex.conj` to `clifford_algebra.involute` and
vice-versa:

* `clifford_algebra_complex.to_complex_involute`
* `clifford_algebra_complex.of_complex_conj`

Note that in this algebra `clifford_algebra.reverse` is the identity and so the clifford conjugate
is the same as `clifford_algebra.involute`.

## Quaternion algebras

* `clifford_algebra_quaternion.equiv`: a `quaternion_algebra` over `R` is equivalent as an
  `R`-algebra to a clifford algebra over `R × R`, sending `i` to `(0, 1)` and `j` to `(1, 0)`.
* `clifford_algebra_quaternion.to_quaternion`: the forward direction of this equiv
* `clifford_algebra_quaternion.of_quaternion`: the reverse direction of this equiv

We show additionally that this equivalence sends `quaternion_algebra.conj` to the clifford conjugate
and vice-versa:

* `clifford_algebra_quaternion.to_quaternion_star`
* `clifford_algebra_quaternion.of_quaternion_conj`

## Dual numbers

* `clifford_algebra_dual_number.equiv`: `R[ε]` is is equivalent as an `R`-algebra to a clifford
  algebra over `R` where `Q = 0`.

-/

open clifford_algebra

/-! ### The clifford algebra isomorphic to a ring -/
namespace clifford_algebra_ring
open_locale complex_conjugate

variables {R : Type*} [comm_ring R]

@[simp]
lemma ι_eq_zero : ι (0 : quadratic_form R unit) = 0 :=
subsingleton.elim _ _

/-- Since the vector space is empty the ring is commutative. -/
instance : comm_ring (clifford_algebra (0 : quadratic_form R unit)) :=
{ mul_comm := λ x y, begin
    induction x using clifford_algebra.induction,
    case h_grade0 : r { apply algebra.commutes, },
    case h_grade1 : x { simp, },
    case h_add : x₁ x₂ hx₁ hx₂ { rw [mul_add, add_mul, hx₁, hx₂], },
    case h_mul : x₁ x₂ hx₁ hx₂ { rw [mul_assoc, hx₂, ←mul_assoc, hx₁, ←mul_assoc], },
  end,
  ..clifford_algebra.ring _ }

lemma reverse_apply (x : clifford_algebra (0 : quadratic_form R unit)) : x.reverse = x :=
begin
  induction x using clifford_algebra.induction,
  case h_grade0 : r { exact reverse.commutes _},
  case h_grade1 : x { rw [ι_eq_zero, linear_map.zero_apply, reverse.map_zero] },
  case h_mul : x₁ x₂ hx₁ hx₂ { rw [reverse.map_mul, mul_comm, hx₁, hx₂] },
  case h_add : x₁ x₂ hx₁ hx₂ { rw [reverse.map_add, hx₁, hx₂] },
end

@[simp] lemma reverse_eq_id :
  (reverse : clifford_algebra (0 : quadratic_form R unit) →ₗ[R] _) = linear_map.id :=
linear_map.ext reverse_apply

@[simp] lemma involute_eq_id :
  (involute : clifford_algebra (0 : quadratic_form R unit) →ₐ[R] _) = alg_hom.id R _ :=
by { ext, simp }

/-- The clifford algebra over a 0-dimensional vector space is isomorphic to its scalars. -/
protected def equiv : clifford_algebra (0 : quadratic_form R unit) ≃ₐ[R] R :=
alg_equiv.of_alg_hom
  (clifford_algebra.lift (0 : quadratic_form R unit) $
    ⟨0, λ m : unit, (zero_mul (0 : R)).trans (algebra_map R _).map_zero.symm⟩)
  (algebra.of_id R _)
  (by { ext x, exact (alg_hom.commutes _ x), })
  (by { ext : 1, rw [ι_eq_zero, linear_map.comp_zero, linear_map.comp_zero], })

end clifford_algebra_ring

/-! ### The clifford algebra isomorphic to the complex numbers -/
namespace clifford_algebra_complex
open_locale complex_conjugate

/-- The quadratic form sending elements to the negation of their square. -/
def Q : quadratic_form ℝ ℝ := -quadratic_form.sq

@[simp]
lemma Q_apply (r : ℝ) : Q r = - (r * r) := rfl

/-- Intermediate result for `clifford_algebra_complex.equiv`: clifford algebras over
`clifford_algebra_complex.Q` above can be converted to `ℂ`. -/
def to_complex : clifford_algebra Q →ₐ[ℝ] ℂ :=
clifford_algebra.lift Q ⟨linear_map.to_span_singleton _ _ complex.I, λ r, begin
  dsimp [linear_map.to_span_singleton, linear_map.id],
  rw mul_mul_mul_comm,
  simp,
end⟩

@[simp]
lemma to_complex_ι (r : ℝ) : to_complex (ι Q r) = r • complex.I :=
clifford_algebra.lift_ι_apply _ _ r

/-- `clifford_algebra.involute` is analogous to `complex.conj`. -/
@[simp] lemma to_complex_involute (c : clifford_algebra Q) :
  to_complex (c.involute) = conj (to_complex c) :=
begin
  have : to_complex (involute (ι Q 1)) = conj (to_complex (ι Q 1)),
  { simp only [involute_ι, to_complex_ι, alg_hom.map_neg, one_smul, complex.conj_I] },
  suffices : to_complex.comp involute = complex.conj_ae.to_alg_hom.comp to_complex,
  { exact alg_hom.congr_fun this c },
  ext : 2,
  exact this
end

/-- Intermediate result for `clifford_algebra_complex.equiv`: `ℂ` can be converted to
`clifford_algebra_complex.Q` above can be converted to. -/
def of_complex : ℂ →ₐ[ℝ] clifford_algebra Q :=
complex.lift ⟨
  clifford_algebra.ι Q 1,
  by rw [clifford_algebra.ι_sq_scalar, Q_apply, one_mul, ring_hom.map_neg, ring_hom.map_one]⟩

@[simp]
lemma of_complex_I : of_complex complex.I = ι Q 1 :=
complex.lift_aux_apply_I _ _

@[simp] lemma to_complex_comp_of_complex : to_complex.comp of_complex = alg_hom.id ℝ ℂ :=
begin
  ext1,
  dsimp only [alg_hom.comp_apply, subtype.coe_mk, alg_hom.id_apply],
  rw [of_complex_I, to_complex_ι, one_smul],
end

@[simp] lemma to_complex_of_complex (c : ℂ) : to_complex (of_complex c) = c :=
alg_hom.congr_fun to_complex_comp_of_complex c

@[simp] lemma of_complex_comp_to_complex :
  of_complex.comp to_complex = alg_hom.id ℝ (clifford_algebra Q) :=
begin
  ext,
  dsimp only [linear_map.comp_apply, subtype.coe_mk, alg_hom.id_apply,
    alg_hom.to_linear_map_apply, alg_hom.comp_apply],
  rw [to_complex_ι, one_smul, of_complex_I],
end

@[simp] lemma of_complex_to_complex (c : clifford_algebra Q) : of_complex (to_complex c) = c :=
alg_hom.congr_fun of_complex_comp_to_complex c

/-- The clifford algebras over `clifford_algebra_complex.Q` is isomorphic as an `ℝ`-algebra to
`ℂ`. -/
@[simps]
protected def equiv : clifford_algebra Q ≃ₐ[ℝ] ℂ :=
alg_equiv.of_alg_hom to_complex of_complex to_complex_comp_of_complex of_complex_comp_to_complex

/-- The clifford algebra is commutative since it is isomorphic to the complex numbers.

TODO: prove this is true for all `clifford_algebra`s over a 1-dimensional vector space. -/
instance : comm_ring (clifford_algebra Q) :=
{ mul_comm := λ x y, clifford_algebra_complex.equiv.injective $
    by rw [alg_equiv.map_mul, mul_comm, alg_equiv.map_mul],
  .. clifford_algebra.ring _ }

/-- `reverse` is a no-op over `clifford_algebra_complex.Q`. -/
lemma reverse_apply (x : clifford_algebra Q) : x.reverse = x :=
begin
  induction x using clifford_algebra.induction,
  case h_grade0 : r { exact reverse.commutes _},
  case h_grade1 : x { rw [reverse_ι] },
  case h_mul : x₁ x₂ hx₁ hx₂ { rw [reverse.map_mul, mul_comm, hx₁, hx₂] },
  case h_add : x₁ x₂ hx₁ hx₂ { rw [reverse.map_add, hx₁, hx₂] },
end

@[simp]
lemma reverse_eq_id : (reverse : clifford_algebra Q →ₗ[ℝ] _) = linear_map.id :=
linear_map.ext reverse_apply

/-- `complex.conj` is analogous to `clifford_algebra.involute`. -/
@[simp] lemma of_complex_conj (c : ℂ) : of_complex (conj c) = (of_complex c).involute :=
clifford_algebra_complex.equiv.injective $
  by rw [equiv_apply, equiv_apply, to_complex_involute, to_complex_of_complex,
    to_complex_of_complex]

-- this name is too short for us to want it visible after `open clifford_algebra_complex`
attribute [protected] Q

end clifford_algebra_complex

/-! ### The clifford algebra isomorphic to the quaternions -/
namespace clifford_algebra_quaternion

open_locale quaternion
open quaternion_algebra

variables {R : Type*} [comm_ring R] (c₁ c₂ : R)

/-- `Q c₁ c₂` is a quadratic form over `R × R` such that `clifford_algebra (Q c₁ c₂)` is isomorphic
as an `R`-algebra to `ℍ[R,c₁,c₂]`. -/
def Q : quadratic_form R (R × R) :=
(c₁ • quadratic_form.sq).prod (c₂ • quadratic_form.sq)

@[simp]
lemma Q_apply (v : R × R) : Q c₁ c₂ v = c₁ * (v.1 * v.1) + c₂ * (v.2 * v.2) := rfl

/-- The quaternion basis vectors within the algebra. -/
@[simps i j k]
def quaternion_basis : quaternion_algebra.basis (clifford_algebra (Q c₁ c₂)) c₁ c₂ :=
{ i := ι (Q c₁ c₂) (1, 0),
  j := ι (Q c₁ c₂) (0, 1),
  k := ι (Q c₁ c₂) (1, 0) * ι (Q c₁ c₂) (0, 1),
  i_mul_i := begin
    rw [ι_sq_scalar, Q_apply, ←algebra.algebra_map_eq_smul_one],
    simp,
  end,
  j_mul_j := begin
    rw [ι_sq_scalar, Q_apply, ←algebra.algebra_map_eq_smul_one],
    simp,
  end,
  i_mul_j := rfl,
  j_mul_i := begin
    rw [eq_neg_iff_add_eq_zero, ι_mul_ι_add_swap, quadratic_form.polar],
    simp,
  end }

variables {c₁ c₂}

/-- Intermediate result of `clifford_algebra_quaternion.equiv`: clifford algebras over
`clifford_algebra_quaternion.Q` can be converted to `ℍ[R,c₁,c₂]`. -/
def to_quaternion : clifford_algebra (Q c₁ c₂) →ₐ[R] ℍ[R,c₁,c₂] :=
clifford_algebra.lift (Q c₁ c₂) ⟨
  { to_fun := λ v, (⟨0, v.1, v.2, 0⟩ : ℍ[R,c₁,c₂]),
    map_add' := λ v₁ v₂, by simp,
    map_smul' := λ r v, by ext; simp },
  λ v, begin
    dsimp,
    ext,
    all_goals {dsimp, ring},
  end⟩

@[simp]
lemma to_quaternion_ι (v : R × R) :
  to_quaternion (ι (Q c₁ c₂) v) = (⟨0, v.1, v.2, 0⟩ : ℍ[R,c₁,c₂]) :=
clifford_algebra.lift_ι_apply _ _ v

/-- The "clifford conjugate" maps to the quaternion conjugate. -/
lemma to_quaternion_star (c : clifford_algebra (Q c₁ c₂)) :
  to_quaternion (star c) = quaternion_algebra.conj (to_quaternion c) :=
begin
  simp only [clifford_algebra.star_def'],
  induction c using clifford_algebra.induction,
  case h_grade0 : r
  { simp only [reverse.commutes, alg_hom.commutes, quaternion_algebra.coe_algebra_map,
      quaternion_algebra.conj_coe], },
  case h_grade1 : x
  { rw [reverse_ι, involute_ι, to_quaternion_ι, alg_hom.map_neg, to_quaternion_ι,
      quaternion_algebra.neg_mk, conj_mk, neg_zero], },
  case h_mul : x₁ x₂ hx₁ hx₂
  { simp only [reverse.map_mul, alg_hom.map_mul, hx₁, hx₂, quaternion_algebra.conj_mul] },
  case h_add : x₁ x₂ hx₁ hx₂
  { simp only [reverse.map_add, alg_hom.map_add, hx₁, hx₂, quaternion_algebra.conj_add] },
end

/-- Map a quaternion into the clifford algebra. -/
def of_quaternion : ℍ[R,c₁,c₂] →ₐ[R] clifford_algebra (Q c₁ c₂) :=
(quaternion_basis c₁ c₂).lift_hom

@[simp] lemma of_quaternion_mk (a₁ a₂ a₃ a₄ : R) :
  of_quaternion (⟨a₁, a₂, a₃, a₄⟩ : ℍ[R,c₁,c₂])
    = algebra_map R _ a₁
    + a₂ • ι (Q c₁ c₂) (1, 0)
    + a₃ • ι (Q c₁ c₂) (0, 1)
    + a₄ • (ι (Q c₁ c₂) (1, 0) * ι (Q c₁ c₂) (0, 1)) := rfl

@[simp]
lemma of_quaternion_comp_to_quaternion :
  of_quaternion.comp to_quaternion = alg_hom.id R (clifford_algebra (Q c₁ c₂)) :=
begin
  ext : 1,
  dsimp, -- before we end up with two goals and have to do this twice
  ext,
  all_goals
  { dsimp,
    rw to_quaternion_ι,
    dsimp,
    simp only [to_quaternion_ι, zero_smul, one_smul, zero_add, add_zero, ring_hom.map_zero], },
end

@[simp] lemma of_quaternion_to_quaternion (c : clifford_algebra (Q c₁ c₂)) :
  of_quaternion (to_quaternion c) = c :=
alg_hom.congr_fun
  (of_quaternion_comp_to_quaternion : _ = alg_hom.id R (clifford_algebra (Q c₁ c₂))) c

@[simp]
lemma to_quaternion_comp_of_quaternion :
  to_quaternion.comp of_quaternion = alg_hom.id R ℍ[R,c₁,c₂] :=
begin
  apply quaternion_algebra.lift.symm.injective,
  ext1; dsimp [quaternion_algebra.basis.lift]; simp,
end

@[simp] lemma to_quaternion_of_quaternion (q : ℍ[R,c₁,c₂]) : to_quaternion (of_quaternion q) = q :=
alg_hom.congr_fun (to_quaternion_comp_of_quaternion : _ = alg_hom.id R ℍ[R,c₁,c₂]) q

/-- The clifford algebra over `clifford_algebra_quaternion.Q c₁ c₂` is isomorphic as an `R`-algebra
to `ℍ[R,c₁,c₂]`. -/
@[simps]
protected def equiv : clifford_algebra (Q c₁ c₂) ≃ₐ[R] ℍ[R,c₁,c₂] :=
alg_equiv.of_alg_hom to_quaternion of_quaternion
  to_quaternion_comp_of_quaternion
  of_quaternion_comp_to_quaternion

/-- The quaternion conjugate maps to the "clifford conjugate" (aka `star`). -/
@[simp] lemma of_quaternion_conj (q : ℍ[R,c₁,c₂]) :
  of_quaternion (q.conj) = star (of_quaternion q) :=
clifford_algebra_quaternion.equiv.injective $
  by rw [equiv_apply, equiv_apply, to_quaternion_star, to_quaternion_of_quaternion,
    to_quaternion_of_quaternion]

-- this name is too short for us to want it visible after `open clifford_algebra_quaternion`
attribute [protected] Q

end clifford_algebra_quaternion

/-! ### The clifford algebra isomorphic to the dual numbers -/
namespace clifford_algebra_dual_number

open_locale dual_number
open dual_number triv_sq_zero_ext

variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]

/-- The clifford algebra over a 1-dimensional vector space with 0 quadratic form is isomorphic to
the dual numbers. -/
protected def equiv : clifford_algebra (0 : quadratic_form R R) ≃ₐ[R] R[ε] :=
alg_equiv.of_alg_hom
  (clifford_algebra.lift (0 : quadratic_form R R) ⟨inr_hom R _, λ m, inr_mul_inr _ m m⟩)
  (dual_number.lift ⟨ι _ (1 : R), ι_mul_ι (1 : R) 1⟩)
  (by { ext x : 1, dsimp, rw [lift_apply_eps, subtype.coe_mk, lift_ι_apply, inr_hom_apply, eps] })
  (by { ext : 2, dsimp, rw [lift_ι_apply, inr_hom_apply, ←eps, lift_apply_eps, subtype.coe_mk] })

@[simp] lemma equiv_ι (r : R) : clifford_algebra_dual_number.equiv (ι _ r) = r • ε :=
(lift_ι_apply _ _ r).trans (inr_eq_smul_eps _)

@[simp] lemma equiv_symm_eps :
  clifford_algebra_dual_number.equiv.symm (eps : R[ε]) = ι (0 : quadratic_form R R) 1 :=
dual_number.lift_apply_eps _

end clifford_algebra_dual_number