/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best
-/
import data.list.big_operators.basic
import algebra.group.opposite
import algebra.group_power.basic
import algebra.group_with_zero.commute
import algebra.group_with_zero.divisibility
import algebra.order.with_zero
import algebra.ring.basic
import algebra.ring.divisibility
import algebra.ring.commute
import data.int.units
import data.set.basic

/-! # Lemmas about `list.sum` and `list.prod` requiring extra algebra imports

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

open mul_opposite list

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

namespace commute

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

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

end commute

namespace list

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

@[to_additive] lemma prod_eq_one_iff [canonically_ordered_monoid M] (l : list M) :
  l.prod = 1 ↔ ∀ x ∈ l, x = (1 : M) :=
⟨all_one_of_le_one_le_of_prod_eq_one (λ _ _, one_le _),
  λ h, by rw [eq_replicate.2 ⟨rfl, h⟩, prod_replicate, one_pow]⟩

/-- If a product of integers is `-1`, then at least one factor must be `-1`. -/
lemma neg_one_mem_of_prod_eq_neg_one {l : list ℤ} (h : l.prod = -1) : (-1 : ℤ) ∈ l :=
begin
  obtain ⟨x, h₁, h₂⟩ := exists_mem_ne_one_of_prod_ne_one (ne_of_eq_of_ne h dec_trivial),
  exact or.resolve_left (int.is_unit_iff.mp (prod_is_unit_iff.mp
         (h.symm ▸ is_unit.neg is_unit_one : is_unit l.prod) x h₁)) h₂ ▸ h₁,
end

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

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

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

section alternating
variables [comm_group α]

@[to_additive]
lemma alternating_prod_append : ∀ l₁ l₂ : list α,
  alternating_prod (l₁ ++ l₂) = alternating_prod l₁ * alternating_prod l₂ ^ (-1 : ℤ) ^ length l₁
| [] l₂ := by simp
| (a :: l₁) l₂ := by simp_rw [cons_append, alternating_prod_cons, alternating_prod_append,
  length_cons, pow_succ, neg_mul, one_mul, zpow_neg, ←div_eq_mul_inv, div_div]

@[to_additive]
lemma alternating_prod_reverse :
  ∀ l : list α, alternating_prod (reverse l) = alternating_prod l ^ (-1 : ℤ) ^ (length l + 1)
| [] := by simp only [alternating_prod_nil, one_zpow, reverse_nil]
| (a :: l) :=
begin
  simp_rw [reverse_cons, alternating_prod_append, alternating_prod_reverse,
    alternating_prod_singleton, alternating_prod_cons, length_reverse, length, pow_succ, neg_mul,
    one_mul, zpow_neg, inv_inv],
  rw [mul_comm, ←div_eq_mul_inv, div_zpow],
end

end alternating

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

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

end list

namespace mul_opposite

open list
variables [monoid M]

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

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

end mul_opposite

section monoid_hom

variables [monoid M] [monoid N]

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

namespace monoid_hom

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

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

end monoid_hom
end monoid_hom


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

! This file was ported from Lean 3 source module algebra.order.sub.defs
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CovariantAndContravariant
import Mathlib.Algebra.Group.Basic
import Mathlib.Algebra.Order.Monoid.Lemmas
import Mathlib.Order.Lattice

/-!
# Ordered Subtraction

This file proves lemmas relating (truncated) subtraction with an order. We provide a class
`OrderedSub` stating that `a - b ≤ c ↔ a ≤ c + b`.

The subtraction discussed here could both be normal subtraction in an additive group or truncated
subtraction on a canonically ordered monoid (`ℕ`, `Multiset`, `PartENat`, `ENNReal`, ...)

## Implementation details

`OrderedSub` is a mixin type-class, so that we can use the results in this file even in cases
where we don't have a `CanonicallyOrderedAddMonoid` instance
(even though that is our main focus). Conversely, this means we can use
`CanonicallyOrderedAddMonoid` without necessarily having to define a subtraction.

The results in this file are ordered by the type-class assumption needed to prove it.
This means that similar results might not be close to each other. Furthermore, we don't prove
implications if a bi-implication can be proven under the same assumptions.

Lemmas using this class are named using `tsub` instead of `sub` (short for "truncated subtraction").
This is to avoid naming conflicts with similar lemmas about ordered groups.

We provide a second version of most results that require `[ContravariantClass α α (+) (≤)]`. In the
second version we replace this type-class assumption by explicit `AddLECancellable` assumptions.

TODO: maybe we should make a multiplicative version of this, so that we can replace some identical
lemmas about subtraction/division in `Ordered[Add]CommGroup` with these.

TODO: generalize `Nat.le_of_le_of_sub_le_sub_right`, `Nat.sub_le_sub_right_iff`,
  `Nat.mul_self_sub_mul_self_eq`
-/

variable {α β : Type _}

/-- `OrderedSub α` means that `α` has a subtraction characterized by `a - b ≤ c ↔ a ≤ c + b`.
In other words, `a - b` is the least `c` such that `a ≤ b + c`.

This is satisfied both by the subtraction in additive ordered groups and by truncated subtraction
in canonically ordered monoids on many specific types.
-/
class OrderedSub (α : Type _) [LE α] [Add α] [Sub α] where
  /-- `a - b` provides a lower bound on `c` such that `a ≤ c + b`. -/
  tsub_le_iff_right : ∀ a b c : α, a - b ≤ c ↔ a ≤ c + b
#align has_ordered_sub OrderedSub

section Add

variable [Preorder α] [Add α] [Sub α] [OrderedSub α] {a b c d : α}

@[simp]
theorem tsub_le_iff_right : a - b ≤ c ↔ a ≤ c + b :=
  OrderedSub.tsub_le_iff_right a b c
#align tsub_le_iff_right tsub_le_iff_right

/-- See `add_tsub_cancel_right` for the equality if `ContravariantClass α α (+) (≤)`. -/
theorem add_tsub_le_right : a + b - b ≤ a :=
  tsub_le_iff_right.mpr le_rfl
#align add_tsub_le_right add_tsub_le_right

theorem le_tsub_add : b ≤ b - a + a :=
  tsub_le_iff_right.mp le_rfl
#align le_tsub_add le_tsub_add

end Add

/-! ### Preorder -/

section OrderedAddCommSemigroup

section Preorder

variable [Preorder α]

section AddCommSemigroup

variable [AddCommSemigroup α] [Sub α] [OrderedSub α] {a b c d : α}

theorem tsub_le_iff_left : a - b ≤ c ↔ a ≤ b + c := by rw [tsub_le_iff_right, add_comm]
#align tsub_le_iff_left tsub_le_iff_left

theorem le_add_tsub : a ≤ b + (a - b) :=
  tsub_le_iff_left.mp le_rfl
#align le_add_tsub le_add_tsub

/-- See `add_tsub_cancel_left` for the equality if `ContravariantClass α α (+) (≤)`. -/
theorem add_tsub_le_left : a + b - a ≤ b :=
  tsub_le_iff_left.mpr le_rfl
#align add_tsub_le_left add_tsub_le_left

theorem tsub_le_tsub_right (h : a ≤ b) (c : α) : a - c ≤ b - c :=
  tsub_le_iff_left.mpr <| h.trans le_add_tsub
#align tsub_le_tsub_right tsub_le_tsub_right

theorem tsub_le_iff_tsub_le : a - b ≤ c ↔ a - c ≤ b := by rw [tsub_le_iff_left, tsub_le_iff_right]
#align tsub_le_iff_tsub_le tsub_le_iff_tsub_le

/-- See `tsub_tsub_cancel_of_le` for the equality. -/
theorem tsub_tsub_le : b - (b - a) ≤ a :=
  tsub_le_iff_right.mpr le_add_tsub
#align tsub_tsub_le tsub_tsub_le

section Cov

variable [CovariantClass α α (· + ·) (· ≤ ·)]

theorem tsub_le_tsub_left (h : a ≤ b) (c : α) : c - b ≤ c - a :=
  tsub_le_iff_left.mpr <| le_add_tsub.trans <| add_le_add_right h _
#align tsub_le_tsub_left tsub_le_tsub_left

theorem tsub_le_tsub (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c :=
  (tsub_le_tsub_right hab _).trans <| tsub_le_tsub_left hcd _
#align tsub_le_tsub tsub_le_tsub

theorem antitone_const_tsub : Antitone fun x => c - x := fun _ _ hxy => tsub_le_tsub rfl.le hxy
#align antitone_const_tsub antitone_const_tsub

/-- See `add_tsub_assoc_of_le` for the equality. -/
theorem add_tsub_le_assoc : a + b - c ≤ a + (b - c) := by
  rw [tsub_le_iff_left, add_left_comm]
  exact add_le_add_left le_add_tsub a
#align add_tsub_le_assoc add_tsub_le_assoc

/-- See `tsub_add_eq_add_tsub` for the equality. -/
theorem add_tsub_le_tsub_add : a + b - c ≤ a - c + b := by
  rw [add_comm, add_comm _ b]
  exact add_tsub_le_assoc
#align add_tsub_le_tsub_add add_tsub_le_tsub_add

theorem add_le_add_add_tsub : a + b ≤ a + c + (b - c) := by
  rw [add_assoc]
  exact add_le_add_left le_add_tsub a
#align add_le_add_add_tsub add_le_add_add_tsub

theorem le_tsub_add_add : a + b ≤ a - c + (b + c) := by
  rw [add_comm a, add_comm (a - c)]
  exact add_le_add_add_tsub
#align le_tsub_add_add le_tsub_add_add

theorem tsub_le_tsub_add_tsub : a - c ≤ a - b + (b - c) := by
  rw [tsub_le_iff_left, ← add_assoc, add_right_comm]
  exact le_add_tsub.trans (add_le_add_right le_add_tsub _)
#align tsub_le_tsub_add_tsub tsub_le_tsub_add_tsub

theorem tsub_tsub_tsub_le_tsub : c - a - (c - b) ≤ b - a := by
  rw [tsub_le_iff_left, tsub_le_iff_left, add_left_comm]
  exact le_tsub_add.trans (add_le_add_left le_add_tsub _)
#align tsub_tsub_tsub_le_tsub tsub_tsub_tsub_le_tsub

theorem tsub_tsub_le_tsub_add {a b c : α} : a - (b - c) ≤ a - b + c :=
  tsub_le_iff_right.2 <|
    calc
      a ≤ a - b + b := le_tsub_add
      _ ≤ a - b + (c + (b - c)) := add_le_add_left le_add_tsub _
      _ = a - b + c + (b - c) := (add_assoc _ _ _).symm

#align tsub_tsub_le_tsub_add tsub_tsub_le_tsub_add

/-- See `tsub_add_tsub_comm` for the equality. -/
theorem add_tsub_add_le_tsub_add_tsub : a + b - (c + d) ≤ a - c + (b - d) := by
  rw [add_comm c, tsub_le_iff_left, add_assoc, ← tsub_le_iff_left, ← tsub_le_iff_left]
  refine' (tsub_le_tsub_right add_tsub_le_assoc c).trans _
  rw [add_comm a, add_comm (a - c)]
  exact add_tsub_le_assoc
#align add_tsub_add_le_tsub_add_tsub add_tsub_add_le_tsub_add_tsub

/-- See `add_tsub_add_eq_tsub_left` for the equality. -/
theorem add_tsub_add_le_tsub_left : a + b - (a + c) ≤ b - c := by
  rw [tsub_le_iff_left, add_assoc]
  exact add_le_add_left le_add_tsub _
#align add_tsub_add_le_tsub_left add_tsub_add_le_tsub_left

/-- See `add_tsub_add_eq_tsub_right` for the equality. -/
theorem add_tsub_add_le_tsub_right : a + c - (b + c) ≤ a - b := by
  rw [tsub_le_iff_left, add_right_comm]
  exact add_le_add_right le_add_tsub c
#align add_tsub_add_le_tsub_right add_tsub_add_le_tsub_right

end Cov

/-! #### Lemmas that assume that an element is `AddLECancellable` -/

namespace AddLECancellable

protected theorem le_add_tsub_swap (hb : AddLECancellable b) : a ≤ b + a - b :=
  hb le_add_tsub
#align add_le_cancellable.le_add_tsub_swap AddLECancellable.le_add_tsub_swap

protected theorem le_add_tsub (hb : AddLECancellable b) : a ≤ a + b - b := by
  rw [add_comm]
  exact hb.le_add_tsub_swap
#align add_le_cancellable.le_add_tsub AddLECancellable.le_add_tsub

protected theorem le_tsub_of_add_le_left (ha : AddLECancellable a) (h : a + b ≤ c) : b ≤ c - a :=
  ha <| h.trans le_add_tsub
#align add_le_cancellable.le_tsub_of_add_le_left AddLECancellable.le_tsub_of_add_le_left

protected theorem le_tsub_of_add_le_right (hb : AddLECancellable b) (h : a + b ≤ c) : a ≤ c - b :=
  hb.le_tsub_of_add_le_left <| by rwa [add_comm]
#align add_le_cancellable.le_tsub_of_add_le_right AddLECancellable.le_tsub_of_add_le_right

end AddLECancellable

/-! ### Lemmas where addition is order-reflecting -/

section Contra

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem le_add_tsub_swap : a ≤ b + a - b :=
  Contravariant.AddLECancellable.le_add_tsub_swap
#align le_add_tsub_swap le_add_tsub_swap

theorem le_add_tsub' : a ≤ a + b - b :=
  Contravariant.AddLECancellable.le_add_tsub
#align le_add_tsub' le_add_tsub'

theorem le_tsub_of_add_le_left (h : a + b ≤ c) : b ≤ c - a :=
  Contravariant.AddLECancellable.le_tsub_of_add_le_left h
#align le_tsub_of_add_le_left le_tsub_of_add_le_left

theorem le_tsub_of_add_le_right (h : a + b ≤ c) : a ≤ c - b :=
  Contravariant.AddLECancellable.le_tsub_of_add_le_right h
#align le_tsub_of_add_le_right le_tsub_of_add_le_right

end Contra

end AddCommSemigroup

variable [AddCommMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

theorem tsub_nonpos : a - b ≤ 0 ↔ a ≤ b := by rw [tsub_le_iff_left, add_zero]
#align tsub_nonpos tsub_nonpos

alias tsub_nonpos ↔ _ tsub_nonpos_of_le
#align tsub_nonpos_of_le tsub_nonpos_of_le

end Preorder

/-! ### Partial order -/

variable [PartialOrder α] [AddCommSemigroup α] [Sub α] [OrderedSub α] {a b c d : α}

theorem tsub_tsub (b a c : α) : b - a - c = b - (a + c) := by
  apply le_antisymm
  · rw [tsub_le_iff_left, tsub_le_iff_left, ← add_assoc, ← tsub_le_iff_left]

  · rw [tsub_le_iff_left, add_assoc, ← tsub_le_iff_left, ← tsub_le_iff_left]

#align tsub_tsub tsub_tsub

theorem tsub_add_eq_tsub_tsub (a b c : α) : a - (b + c) = a - b - c :=
  (tsub_tsub _ _ _).symm
#align tsub_add_eq_tsub_tsub tsub_add_eq_tsub_tsub

theorem tsub_add_eq_tsub_tsub_swap (a b c : α) : a - (b + c) = a - c - b := by
  rw [add_comm]
  apply tsub_add_eq_tsub_tsub
#align tsub_add_eq_tsub_tsub_swap tsub_add_eq_tsub_tsub_swap

theorem tsub_right_comm : a - b - c = a - c - b := by
  rw [←tsub_add_eq_tsub_tsub, tsub_add_eq_tsub_tsub_swap]

#align tsub_right_comm tsub_right_comm

/-! ### Lemmas that assume that an element is `AddLECancellable`. -/

namespace AddLECancellable

protected theorem tsub_eq_of_eq_add (hb : AddLECancellable b) (h : a = c + b) : a - b = c :=
  le_antisymm (tsub_le_iff_right.mpr h.le) <| by
    rw [h]
    exact hb.le_add_tsub
#align add_le_cancellable.tsub_eq_of_eq_add AddLECancellable.tsub_eq_of_eq_add

protected theorem eq_tsub_of_add_eq (hc : AddLECancellable c) (h : a + c = b) : a = b - c :=
  (hc.tsub_eq_of_eq_add h.symm).symm
#align add_le_cancellable.eq_tsub_of_add_eq AddLECancellable.eq_tsub_of_add_eq

protected theorem tsub_eq_of_eq_add_rev (hb : AddLECancellable b) (h : a = b + c) : a - b = c :=
  hb.tsub_eq_of_eq_add <| by rw [add_comm, h]
#align add_le_cancellable.tsub_eq_of_eq_add_rev AddLECancellable.tsub_eq_of_eq_add_rev

@[simp]
protected theorem add_tsub_cancel_right (hb : AddLECancellable b) : a + b - b = a :=
  hb.tsub_eq_of_eq_add <| by rw [add_comm]
#align add_le_cancellable.add_tsub_cancel_right AddLECancellable.add_tsub_cancel_right

@[simp]
protected theorem add_tsub_cancel_left (ha : AddLECancellable a) : a + b - a = b :=
  ha.tsub_eq_of_eq_add <| add_comm a b
#align add_le_cancellable.add_tsub_cancel_left AddLECancellable.add_tsub_cancel_left

protected theorem lt_add_of_tsub_lt_left (hb : AddLECancellable b) (h : a - b < c) : a < b + c := by
  rw [lt_iff_le_and_ne, ← tsub_le_iff_left]
  refine' ⟨h.le, _⟩
  rintro rfl
  simp [hb] at h
#align add_le_cancellable.lt_add_of_tsub_lt_left AddLECancellable.lt_add_of_tsub_lt_left

protected

protected theorem lt_tsub_of_add_lt_right (hc : AddLECancellable c) (h : a + c < b) : a < b - c :=
  (hc.le_tsub_of_add_le_right h.le).lt_of_ne <| by
    rintro rfl
    exact h.not_le le_tsub_add
#align add_le_cancellable.lt_tsub_of_add_lt_right AddLECancellable.lt_tsub_of_add_lt_right

protected theorem lt_tsub_of_add_lt_left (ha : AddLECancellable a) (h : a + c < b) : c < b - a :=
  ha.lt_tsub_of_add_lt_right <| by rwa [add_comm]
#align add_le_cancellable.lt_tsub_of_add_lt_left AddLECancellable.lt_tsub_of_add_lt_left

end AddLECancellable

/-! #### Lemmas where addition is order-reflecting. -/

section Contra

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem tsub_eq_of_eq_add (h : a = c + b) : a - b = c :=
  Contravariant.AddLECancellable.tsub_eq_of_eq_add h
#align tsub_eq_of_eq_add tsub_eq_of_eq_add

theorem eq_tsub_of_add_eq (h : a + c = b) : a = b - c :=
  Contravariant.AddLECancellable.eq_tsub_of_add_eq h
#align eq_tsub_of_add_eq eq_tsub_of_add_eq

theorem tsub_eq_of_eq_add_rev (h : a = b + c) : a - b = c :=
  Contravariant.AddLECancellable.tsub_eq_of_eq_add_rev h
#align tsub_eq_of_eq_add_rev tsub_eq_of_eq_add_rev

@[simp]
theorem add_tsub_cancel_right (a b : α) : a + b - b = a :=
  Contravariant.AddLECancellable.add_tsub_cancel_right
#align add_tsub_cancel_right add_tsub_cancel_right

@[simp]
theorem add_tsub_cancel_left (a b : α) : a + b - a = b :=
  Contravariant.AddLECancellable.add_tsub_cancel_left
#align add_tsub_cancel_left add_tsub_cancel_left

theorem lt_add_of_tsub_lt_left (h : a - b < c) : a < b + c :=
  Contravariant.AddLECancellable.lt_add_of_tsub_lt_left h
#align lt_add_of_tsub_lt_left lt_add_of_tsub_lt_left

theorem lt_add_of_tsub_lt_right (h : a - c < b) : a < b + c :=
  Contravariant.AddLECancellable.lt_add_of_tsub_lt_right h
#align lt_add_of_tsub_lt_right lt_add_of_tsub_lt_right

/-- This lemma (and some of its corollaries) also holds for `ENNReal`, but this proof doesn't work
for it. Maybe we should add this lemma as field to `OrderedSub`? -/
theorem lt_tsub_of_add_lt_left : a + c < b → c < b - a :=
  Contravariant.AddLECancellable.lt_tsub_of_add_lt_left
#align lt_tsub_of_add_lt_left lt_tsub_of_add_lt_left

theorem lt_tsub_of_add_lt_right : a + c < b → a < b - c :=
  Contravariant.AddLECancellable.lt_tsub_of_add_lt_right
#align lt_tsub_of_add_lt_right lt_tsub_of_add_lt_right

end Contra

section Both

variable [CovariantClass α α (· + ·) (· ≤ ·)] [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem add_tsub_add_eq_tsub_right (a c b : α) : a + c - (b + c) = a - b := by
  refine' add_tsub_add_le_tsub_right.antisymm (tsub_le_iff_right.2 <| le_of_add_le_add_right _)
  exact c
  rw [add_assoc]
  exact le_tsub_add
#align add_tsub_add_eq_tsub_right add_tsub_add_eq_tsub_right

theorem add_tsub_add_eq_tsub_left (a b c : α) : a + b - (a + c) = b - c := by
  rw [add_comm a b, add_comm a c, add_tsub_add_eq_tsub_right]
#align add_tsub_add_eq_tsub_left add_tsub_add_eq_tsub_left

end Both

end OrderedAddCommSemigroup

/-! ### Lemmas in a linearly ordered monoid. -/

section LinearOrder

variable {a b c d : α} [LinearOrder α] [AddCommSemigroup α] [Sub α] [OrderedSub α]

/-- See `lt_of_tsub_lt_tsub_right_of_le` for a weaker statement in a partial order. -/
theorem lt_of_tsub_lt_tsub_right (h : a - c < b - c) : a < b :=
  lt_imp_lt_of_le_imp_le (fun h => tsub_le_tsub_right h c) h
#align lt_of_tsub_lt_tsub_right lt_of_tsub_lt_tsub_right

/-- See `lt_tsub_iff_right_of_le` for a weaker statement in a partial order. -/
theorem lt_tsub_iff_right : a < b - c ↔ a + c < b :=
  lt_iff_lt_of_le_iff_le tsub_le_iff_right
#align lt_tsub_iff_right lt_tsub_iff_right

/-- See `lt_tsub_iff_left_of_le` for a weaker statement in a partial order. -/
theorem lt_tsub_iff_left : a < b - c ↔ c + a < b :=
  lt_iff_lt_of_le_iff_le tsub_le_iff_left
#align lt_tsub_iff_left lt_tsub_iff_left

theorem lt_tsub_comm : a < b - c ↔ c < b - a :=
  lt_tsub_iff_left.trans lt_tsub_iff_right.symm
#align lt_tsub_comm lt_tsub_comm

section Cov

variable [CovariantClass α α (· + ·) (· ≤ ·)]

/-- See `lt_of_tsub_lt_tsub_left_of_le` for a weaker statement in a partial order. -/
theorem lt_of_tsub_lt_tsub_left (h : a - b < a - c) : c < b :=
  lt_imp_lt_of_le_imp_le (fun h => tsub_le_tsub_left h a) h
#align lt_of_tsub_lt_tsub_left lt_of_tsub_lt_tsub_left

end Cov

end LinearOrder

section OrderedAddCommMonoid

variable [PartialOrder α] [AddCommMonoid α] [Sub α] [OrderedSub α]

@[simp]
theorem tsub_zero (a : α) : a - 0 = a :=
  AddLECancellable.tsub_eq_of_eq_add addLECancellable_zero (add_zero _).symm
#align tsub_zero tsub_zero

end OrderedAddCommMonoid


/-
Copyright (c) 2018 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/
import algebra.module.pi
import algebra.big_operators.basic

/-!
# Basic properties of holors

Holors are indexed collections of tensor coefficients. Confusingly,
they are often called tensors in physics and in the neural network
community.

A holor is simply a multidimensional array of values. The size of a
holor is specified by a `list ℕ`, whose length is called the dimension
of the holor.

The tensor product of `x₁ : holor α ds₁` and `x₂ : holor α ds₂` is the
holor given by `(x₁ ⊗ x₂) (i₁ ++ i₂) = x₁ i₁ * x₂ i₂`. A holor is "of
rank at most 1" if it is a tensor product of one-dimensional holors.
The CP rank of a holor `x` is the smallest N such that `x` is the sum
of N holors of rank at most 1.

Based on the tensor library found in <https://www.isa-afp.org/entries/Deep_Learning.html>

## References

* <https://en.wikipedia.org/wiki/Tensor_rank_decomposition>
-/

universes u

open list

open_locale big_operators

/-- `holor_index ds` is the type of valid index tuples used to identify an entry of a holor
of dimensions `ds`. -/
def holor_index (ds : list ℕ) : Type := { is : list ℕ // forall₂ (<) is ds}

namespace holor_index
variables {ds₁ ds₂ ds₃ : list ℕ}

def take : Π {ds₁ : list ℕ}, holor_index (ds₁ ++ ds₂) → holor_index ds₁
| ds is := ⟨ list.take (length ds) is.1, forall₂_take_append is.1 ds ds₂ is.2 ⟩

def drop : Π {ds₁ : list ℕ}, holor_index (ds₁ ++ ds₂) → holor_index ds₂
| ds is := ⟨ list.drop (length ds) is.1, forall₂_drop_append is.1 ds ds₂ is.2 ⟩

lemma cast_type (is : list ℕ) (eq : ds₁ = ds₂) (h : forall₂ (<) is ds₁) :
  (cast (congr_arg holor_index eq) ⟨is, h⟩).val = is :=
by subst eq; refl

def assoc_right :
  holor_index (ds₁ ++ ds₂ ++ ds₃) → holor_index (ds₁ ++ (ds₂ ++ ds₃)) :=
cast (congr_arg holor_index (append_assoc ds₁ ds₂ ds₃))

def assoc_left :
  holor_index (ds₁ ++ (ds₂ ++ ds₃)) → holor_index (ds₁ ++ ds₂ ++ ds₃) :=
cast (congr_arg holor_index (append_assoc ds₁ ds₂ ds₃).symm)

lemma take_take :
  ∀ t : holor_index (ds₁ ++ ds₂ ++ ds₃),
  t.assoc_right.take = t.take.take
| ⟨ is , h ⟩ := subtype.eq $ by simp [assoc_right,take, cast_type, list.take_take,
                                     nat.le_add_right, min_eq_left]

lemma drop_take :
  ∀ t : holor_index (ds₁ ++ ds₂ ++ ds₃),
  t.assoc_right.drop.take = t.take.drop
| ⟨ is , h ⟩ := subtype.eq (by simp [assoc_right, take, drop, cast_type, list.drop_take])

lemma drop_drop :
  ∀ t : holor_index (ds₁ ++ ds₂ ++ ds₃),
  t.assoc_right.drop.drop = t.drop
| ⟨ is , h ⟩ := subtype.eq (by simp [add_comm, assoc_right, drop, cast_type, list.drop_drop])

end holor_index

/-- Holor (indexed collections of tensor coefficients) -/
def holor (α : Type u) (ds:list ℕ) := holor_index ds → α

namespace holor

variables {α : Type} {d : ℕ} {ds : list ℕ} {ds₁ : list ℕ} {ds₂ : list ℕ} {ds₃ : list ℕ}

instance [inhabited α] : inhabited (holor α ds) := ⟨λ t, default α⟩
instance [has_zero α] : has_zero (holor α ds) := ⟨λ t, 0⟩
instance [has_add α] : has_add (holor α ds) := ⟨λ x y t, x t + y t⟩
instance [has_neg α] : has_neg (holor α ds) :=  ⟨λ a t, - a t⟩

instance [add_semigroup α] : add_semigroup (holor α ds) :=
by refine_struct { add := (+), .. }; tactic.pi_instance_derive_field

instance [add_comm_semigroup α] : add_comm_semigroup (holor α ds) :=
by refine_struct { add := (+), .. }; tactic.pi_instance_derive_field

instance [add_monoid α] : add_monoid (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := λ n x i, nsmul n (x i) };
tactic.pi_instance_derive_field

instance [add_comm_monoid α] : add_comm_monoid (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := λ n x i, nsmul n (x i) };
tactic.pi_instance_derive_field

instance [add_group α] : add_group (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := λ n x i, nsmul n (x i),
  gsmul := λ n x i, gsmul n (x i) };
tactic.pi_instance_derive_field

instance [add_comm_group α] : add_comm_group (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := λ n x i, nsmul n (x i),
  gsmul := λ n x i, gsmul n (x i) };
tactic.pi_instance_derive_field

/- scalar product -/

instance [has_mul α] : has_scalar α (holor α ds) :=
  ⟨λ a x, λ t, a * x t⟩

instance [semiring α] : module α (holor α ds) := pi.module _ _ _

/-- The tensor product of two holors. -/
def mul [s : has_mul α] (x : holor α ds₁) (y : holor α ds₂) : holor α (ds₁ ++ ds₂) :=
  λ t, x (t.take) * y (t.drop)

local infix ` ⊗ ` : 70 := mul

lemma cast_type (eq : ds₁ = ds₂) (a : holor α ds₁) :
  cast (congr_arg (holor α) eq) a = (λ t, a (cast (congr_arg holor_index eq.symm) t)) :=
by subst eq; refl

def assoc_right :
  holor α (ds₁ ++ ds₂ ++ ds₃) → holor α (ds₁ ++ (ds₂ ++ ds₃)) :=
cast (congr_arg (holor α) (append_assoc ds₁ ds₂ ds₃))

def assoc_left :
  holor α (ds₁ ++ (ds₂ ++ ds₃)) → holor α (ds₁ ++ ds₂ ++ ds₃) :=
cast (congr_arg (holor α) (append_assoc ds₁ ds₂ ds₃).symm)

lemma mul_assoc0 [semigroup α] (x : holor α ds₁) (y : holor α ds₂) (z : holor α ds₃) :
  x ⊗ y ⊗ z = (x ⊗ (y ⊗ z)).assoc_left :=
funext (assume t : holor_index (ds₁ ++ ds₂ ++ ds₃),
begin
  rw assoc_left,
  unfold mul,
  rw mul_assoc,
  rw [←holor_index.take_take, ←holor_index.drop_take, ←holor_index.drop_drop],
  rw cast_type,
  refl,
  rw append_assoc
end)

lemma mul_assoc [semigroup α] (x : holor α ds₁) (y : holor α ds₂) (z : holor α ds₃) :
  mul (mul x y) z == (mul x (mul y z)) :=
by simp [cast_heq, mul_assoc0, assoc_left].

lemma mul_left_distrib [distrib α] (x : holor α ds₁) (y : holor α ds₂) (z : holor α ds₂) :
  x ⊗ (y + z) = x ⊗ y + x ⊗ z :=
funext (λt, left_distrib (x (holor_index.take t)) (y (holor_index.drop t)) (z (holor_index.drop t)))

lemma mul_right_distrib [distrib α] (x : holor α ds₁) (y : holor α ds₁) (z : holor α ds₂) :
  (x + y) ⊗ z = x ⊗ z + y ⊗ z :=
funext $ λt, add_mul (x (holor_index.take t)) (y (holor_index.take t)) (z (holor_index.drop t))

@[simp] lemma zero_mul {α : Type} [ring α] (x : holor α ds₂) :
  (0 : holor α ds₁) ⊗ x = 0 :=
funext (λ t, zero_mul (x (holor_index.drop t)))

@[simp] lemma mul_zero {α : Type} [ring α] (x : holor α ds₁) :
  x ⊗ (0 :holor α ds₂) = 0 :=
funext (λ t, mul_zero (x (holor_index.take t)))

lemma mul_scalar_mul [monoid α] (x : holor α []) (y : holor α ds) :
  x ⊗ y = x ⟨[], forall₂.nil⟩ • y :=
by simp [mul, has_scalar.smul, holor_index.take, holor_index.drop]

/- holor slices -/

/-- A slice is a subholor consisting of all entries with initial index i. -/
def slice (x : holor α (d :: ds)) (i : ℕ) (h : i < d) : holor α ds :=
  (λ is : holor_index ds, x ⟨ i :: is.1, forall₂.cons h is.2⟩)

/-- The 1-dimensional "unit" holor with 1 in the `j`th position. -/
def unit_vec [monoid α] [add_monoid α] (d : ℕ) (j : ℕ) : holor α [d] :=
  λ ti, if ti.1 = [j] then 1 else 0

lemma holor_index_cons_decomp (p: holor_index (d :: ds) → Prop) :
  Π (t : holor_index (d :: ds)),
    (∀ i is, Π h : t.1 = i :: is, p ⟨ i :: is, begin rw [←h], exact t.2 end ⟩ ) → p t
| ⟨[], hforall₂⟩        hp := absurd (forall₂_nil_left_iff.1 hforall₂) (cons_ne_nil d ds)
| ⟨(i :: is), hforall₂⟩ hp := hp i is rfl

/-- Two holors are equal if all their slices are equal. -/
lemma slice_eq (x : holor α (d :: ds)) (y : holor α (d :: ds))
  (h : slice x = slice y) : x = y :=
funext $ λ t : holor_index (d :: ds), holor_index_cons_decomp (λ t, x t = y t) t $ λ i is hiis,
have hiisdds: forall₂ (<) (i :: is) (d :: ds), begin rw [←hiis], exact t.2 end,
have hid:     i<d,                             from (forall₂_cons.1 hiisdds).1,
have hisds:   forall₂ (<) is ds,               from (forall₂_cons.1 hiisdds).2,
calc
  x ⟨i :: is, _⟩ = slice x i hid ⟨is, hisds⟩  : congr_arg (λ t, x t) (subtype.eq rfl)
              ... = slice y i hid ⟨is, hisds⟩  : by rw h
              ... = y ⟨i :: is, _⟩             : congr_arg (λ t, y t) (subtype.eq rfl)

lemma slice_unit_vec_mul [ring α] {i : ℕ} {j : ℕ}
  (hid : i < d) (x : holor α ds) :
  slice (unit_vec d j ⊗ x) i hid = if i=j then x else 0 :=
funext $ λ t : holor_index ds, if h : i = j
  then by simp [slice, mul, holor_index.take, unit_vec, holor_index.drop, h]
  else by simp [slice, mul, holor_index.take, unit_vec, holor_index.drop, h]; refl

lemma slice_add [has_add α] (i : ℕ) (hid : i < d)  (x : holor α (d :: ds)) (y : holor α (d :: ds)) :
  slice x i hid + slice y i hid = slice (x + y) i hid := funext (λ t, by simp [slice,(+)])

lemma slice_zero [has_zero α] (i : ℕ) (hid : i < d)  :
  slice (0 : holor α (d :: ds)) i hid = 0 := rfl

lemma slice_sum [add_comm_monoid α] {β : Type}
  (i : ℕ) (hid : i < d) (s : finset β) (f : β → holor α (d :: ds)) :
  ∑ x in s, slice (f x) i hid = slice (∑ x in s, f x) i hid :=
begin
  letI := classical.dec_eq β,
  refine finset.induction_on s _ _,
  { simp [slice_zero] },
  { intros _ _ h_not_in ih,
    rw [finset.sum_insert h_not_in, ih, slice_add, finset.sum_insert h_not_in] }
end

/-- The original holor can be recovered from its slices by multiplying with unit vectors and
summing up. -/
@[simp] lemma sum_unit_vec_mul_slice [ring α] (x : holor α (d :: ds)) :
  ∑ i in (finset.range d).attach,
    unit_vec d i ⊗ slice x i (nat.succ_le_of_lt (finset.mem_range.1 i.prop)) = x :=
begin
  apply slice_eq _ _ _,
  ext i hid,
  rw [←slice_sum],
  simp only [slice_unit_vec_mul hid],
  rw finset.sum_eq_single (subtype.mk i $ finset.mem_range.2 hid),
  { simp },
  { assume (b : {x // x ∈ finset.range d}) (hb : b ∈ (finset.range d).attach) (hbi : b ≠ ⟨i, _⟩),
    have hbi' : i ≠ b,
    { simpa only [ne.def, subtype.ext_iff, subtype.coe_mk] using hbi.symm },
    simp [hbi'] },
  { assume hid' : subtype.mk i _ ∉ finset.attach (finset.range d),
    exfalso,
    exact absurd (finset.mem_attach _ _) hid'
  }
end

/- CP rank -/

/-- `cprank_max1 x` means `x` has CP rank at most 1, that is,
  it is the tensor product of 1-dimensional holors. -/
inductive cprank_max1 [has_mul α]: Π {ds}, holor α ds → Prop
| nil (x : holor α []) :
    cprank_max1 x
| cons {d} {ds} (x : holor α [d]) (y : holor α ds) :
    cprank_max1 y → cprank_max1 (x ⊗ y)

/-- `cprank_max N x` means `x` has CP rank at most `N`, that is,
  it can be written as the sum of N holors of rank at most 1. -/
inductive cprank_max [has_mul α] [add_monoid α] : ℕ → Π {ds}, holor α ds → Prop
| zero {ds} :
    cprank_max 0 (0 : holor α ds)
| succ n {ds} (x : holor α ds) (y : holor α ds) :
    cprank_max1 x → cprank_max n y →  cprank_max (n+1) (x + y)

lemma cprank_max_nil [monoid α] [add_monoid α] (x : holor α nil) : cprank_max 1 x :=
  have h : _, from cprank_max.succ 0 x 0 (cprank_max1.nil x) (cprank_max.zero),
  by rwa [add_zero x, zero_add] at h

lemma cprank_max_1 [monoid α] [add_monoid α] {x : holor α ds}
  (h : cprank_max1 x) : cprank_max 1 x :=
have h' : _, from cprank_max.succ 0 x 0 h cprank_max.zero,
by rwa [zero_add, add_zero] at h'

lemma cprank_max_add [monoid α] [add_monoid α]:
  ∀ {m : ℕ} {n : ℕ} {x : holor α ds} {y : holor α ds},
  cprank_max m x → cprank_max n y → cprank_max (m + n) (x + y)
| 0     n x y (cprank_max.zero) hy := by simp [hy]
| (m+1) n _ y (cprank_max.succ k x₁ x₂ hx₁ hx₂) hy :=
begin
  simp only [add_comm, add_assoc],
  apply cprank_max.succ,
  { assumption },
  { exact cprank_max_add hx₂ hy }
end

lemma cprank_max_mul [ring α] :
  ∀ (n : ℕ) (x : holor α [d]) (y : holor α ds), cprank_max n y → cprank_max n (x ⊗ y)
| 0 x _ (cprank_max.zero) := by simp [mul_zero x, cprank_max.zero]
| (n+1) x _ (cprank_max.succ k y₁ y₂ hy₁ hy₂) :=
begin
  rw mul_left_distrib,
  rw nat.add_comm,
  apply cprank_max_add,
  { exact cprank_max_1 (cprank_max1.cons _ _ hy₁) },
  { exact cprank_max_mul k x y₂ hy₂ }
end

lemma cprank_max_sum [ring α] {β} {n : ℕ} (s : finset β) (f : β → holor α ds) :
  (∀ x ∈ s, cprank_max n (f x)) → cprank_max (s.card * n) (∑ x in s, f x) :=
by letI := classical.dec_eq β;
exact finset.induction_on s
  (by simp [cprank_max.zero])
  (begin
    assume x s (h_x_notin_s : x ∉ s) ih h_cprank,
    simp only [finset.sum_insert h_x_notin_s,finset.card_insert_of_not_mem h_x_notin_s],
    rw nat.right_distrib,
    simp only [nat.one_mul, nat.add_comm],
    have ih' : cprank_max (finset.card s * n) (∑ x in s, f x),
    {
      apply ih,
      assume (x : β) (h_x_in_s: x ∈ s),
      simp only [h_cprank, finset.mem_insert_of_mem, h_x_in_s]
    },
    exact (cprank_max_add (h_cprank x (finset.mem_insert_self x s)) ih')
  end)

lemma cprank_max_upper_bound [ring α] : Π {ds}, ∀ x : holor α ds, cprank_max ds.prod x
| [] x := cprank_max_nil x
| (d :: ds) x :=
have h_summands : Π (i : {x // x ∈ finset.range d}),
  cprank_max ds.prod (unit_vec d i.1 ⊗ slice x i.1 (mem_range.1 i.2)),
  from λ i, cprank_max_mul _ _ _ (cprank_max_upper_bound (slice x i.1 (mem_range.1 i.2))),
have h_dds_prod : (list.cons d ds).prod = finset.card (finset.range d) * prod ds,
  by simp [finset.card_range],
have cprank_max (finset.card (finset.attach (finset.range d)) * prod ds)
  (∑ i in finset.attach (finset.range d), unit_vec d (i.val)⊗slice x (i.val) (mem_range.1 i.2)),
  from cprank_max_sum (finset.range d).attach _ (λ i _, h_summands i),
have h_cprank_max_sum : cprank_max (finset.card (finset.range d) * prod ds)
  (∑ i in finset.attach (finset.range d), unit_vec d (i.val)⊗slice x (i.val) (mem_range.1 i.2)),
  by rwa [finset.card_attach] at this,
begin
  rw [←sum_unit_vec_mul_slice x],
  rw [h_dds_prod],
  exact h_cprank_max_sum,
end

/-- The CP rank of a holor `x`: the smallest N such that
  `x` can be written as the sum of N holors of rank at most 1. -/
noncomputable def cprank [ring α] (x : holor α ds) : nat :=
@nat.find (λ n, cprank_max n x) (classical.dec_pred _) ⟨ds.prod, cprank_max_upper_bound x⟩

lemma cprank_upper_bound [ring α] :
  Π {ds}, ∀ x : holor α ds, cprank x ≤ ds.prod :=
λ ds (x : holor α ds),
  by letI := classical.dec_pred (λ (n : ℕ), cprank_max n x);
  exact nat.find_min'
    ⟨ds.prod, show (λ n, cprank_max n x) ds.prod, from cprank_max_upper_bound x⟩
    (cprank_max_upper_bound x)

end holor


/-
Copyright (c) 2020. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring
import Mathlib.tactic.doc_commands
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# `group`

Normalizes expressions in the language of groups. The basic idea is to use the simplifier
to put everything into a product of group powers (`gpow` which takes a group element and an
integer), then simplify the exponents using the `ring` tactic. The process needs to be repeated
since `ring` can normalize an exponent to zero, leading to a factor that can be removed
before collecting exponents again. The simplifier step also uses some extra lemmas to avoid
some `ring` invocations.

## Tags

group_theory
-/

-- The next four lemmas are not general purpose lemmas, they are intended for use only by

-- the `group` tactic.

theorem tactic.group.gpow_trick {G : Type u_1} [group G] (a : G) (b : G) (n : ℤ) (m : ℤ) :
    a * b ^ n * b ^ m = a * b ^ (n + m) :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (a * b ^ n * b ^ m = a * b ^ (n + m))) (mul_assoc a (b ^ n) (b ^ m))))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (a * (b ^ n * b ^ m) = a * b ^ (n + m))) (Eq.symm (gpow_add b n m))))
      (Eq.refl (a * b ^ (n + m))))

theorem tactic.group.gpow_trick_one {G : Type u_1} [group G] (a : G) (b : G) (m : ℤ) :
    a * b * b ^ m = a * b ^ (m + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b * b ^ m = a * b ^ (m + 1))) (mul_assoc a b (b ^ m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b * b ^ m) = a * b ^ (m + 1))) (mul_self_gpow b m)))
      (Eq.refl (a * b ^ (m + 1))))

theorem tactic.group.gpow_trick_one' {G : Type u_1} [group G] (a : G) (b : G) (n : ℤ) :
    a * b ^ n * b = a * b ^ (n + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b ^ n * b = a * b ^ (n + 1))) (mul_assoc a (b ^ n) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b ^ n * b) = a * b ^ (n + 1))) (mul_gpow_self b n)))
      (Eq.refl (a * b ^ (n + 1))))

theorem tactic.group.gpow_trick_sub {G : Type u_1} [group G] (a : G) (b : G) (n : ℤ) (m : ℤ) :
    a * b ^ n * b ^ (-m) = a * b ^ (n - m) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (a * b ^ n * b ^ (-m) = a * b ^ (n - m)))
        (mul_assoc a (b ^ n) (b ^ (-m)))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (a * (b ^ n * b ^ (-m)) = a * b ^ (n - m)))
          (Eq.symm (gpow_add b n (-m)))))
      (Eq.refl (a * b ^ (n + -m))))

namespace tactic

/-- Auxilliary tactic for the `group` tactic. Calls the simplifier only. -/
/-- Auxilliary tactic for the `group` tactic. Calls `ring` to normalize exponents. -/
end tactic

namespace tactic.interactive

/--
Tactic for normalizing expressions in multiplicative groups, without assuming
commutativity, using only the group axioms without any information about which group
is manipulated.

(For additive commutative groups, use the `abel` tactic instead.)

Example:
```lean
example {G : Type} [group G] (a b c d : G) (h : c = (a*b^2)*((b*b)⁻¹*a⁻¹)*d) : a*c*d⁻¹ = a :=
begin
  group at h, -- normalizes `h` which becomes `h : c = d`
  rw h,       -- the goal is now `a*d*d⁻¹ = a`
  group,      -- which then normalized and closed
end
```
-/
end tactic.interactive

end Mathlib


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import data.bool tools.helper_tactics
open bool eq.ops decidable helper_tactics

namespace pos_num
  theorem succ_not_is_one (a : pos_num) : is_one (succ a) = ff :=
  pos_num.induction_on a rfl (take n iH, rfl) (take n iH, rfl)

  theorem succ_one                : succ one = bit0 one
  theorem succ_bit1 (a : pos_num) : succ (bit1 a) = bit0 (succ a)
  theorem succ_bit0 (a : pos_num) : succ (bit0 a) = bit1 a

  theorem ne_of_bit0_ne_bit0 {a b : pos_num} (H₁ : bit0 a ≠ bit0 b) : a ≠ b :=
  suppose a = b,
  absurd rfl (this ▸ H₁)

  theorem ne_of_bit1_ne_bit1 {a b : pos_num} (H₁ : bit1 a ≠ bit1 b) : a ≠ b :=
  suppose a = b,
  absurd rfl (this ▸ H₁)

  theorem pred_succ : ∀ (a : pos_num), pred (succ a) = a
  | one      := rfl
  | (bit0 a) := by rewrite succ_bit0
  | (bit1 a) :=
      calc
        pred (succ (bit1 a)) = cond (is_one (succ a)) one (bit1 (pred (succ a))) : rfl
                       ...   = cond ff one (bit1 (pred (succ a)))                : succ_not_is_one
                       ...   = bit1 (pred (succ a))                              : rfl
                       ...   = bit1 a                                            : pred_succ a

  section
  variables (a b : pos_num)

  theorem one_add_one     : one + one = bit0 one
  theorem one_add_bit0    : one + (bit0 a) = bit1 a
  theorem one_add_bit1    : one + (bit1 a) = succ (bit1 a)
  theorem bit0_add_one    : (bit0 a) + one = bit1 a
  theorem bit1_add_one    : (bit1 a) + one = succ (bit1 a)
  theorem bit0_add_bit0   : (bit0 a) + (bit0 b) = bit0 (a + b)
  theorem bit0_add_bit1   : (bit0 a) + (bit1 b) = bit1 (a + b)
  theorem bit1_add_bit0   : (bit1 a) + (bit0 b) = bit1 (a + b)
  theorem bit1_add_bit1   : (bit1 a) + (bit1 b) = succ (bit1 (a + b))
  theorem one_mul         : one * a = a
  end

  theorem mul_one         : ∀ a, a * one = a
  | one      := rfl
  | (bit1 n) :=
      calc bit1 n * one = bit0 (n * one) + one : rfl
                   ...  = bit0 n + one         : mul_one n
                   ...  = bit1 n               : bit0_add_one
  | (bit0 n) :=
      calc bit0 n * one = bit0 (n * one)       : rfl
                    ... = bit0 n               : mul_one n

  theorem decidable_eq [instance] : ∀ (a b : pos_num), decidable (a = b)
  | one      one      := inl rfl
  | one      (bit0 b) := inr (by contradiction)
  | one      (bit1 b) := inr (by contradiction)
  | (bit0 a) one      := inr (by contradiction)
  | (bit0 a) (bit0 b) :=
    match decidable_eq a b with
    | inl H₁  := inl (by rewrite H₁)
    | inr H₁  := inr (by intro H; injection H; contradiction)
    end
  | (bit0 a) (bit1 b) := inr (by contradiction)
  | (bit1 a) one      := inr (by contradiction)
  | (bit1 a) (bit0 b) := inr (by contradiction)
  | (bit1 a) (bit1 b) :=
    match decidable_eq a b with
    | inl H₁  := inl (by rewrite H₁)
    | inr H₁  := inr (by intro H; injection H; contradiction)
    end

  local notation a < b         := (lt a b = tt)
  local notation a ` ≮ `:50 b:50 := (lt a b = ff)

  theorem lt_one_right_eq_ff : ∀ a : pos_num, a ≮ one
  | one      := rfl
  | (bit0 a) := rfl
  | (bit1 a) := rfl

  theorem lt_one_succ_eq_tt : ∀ a : pos_num, one < succ a
  | one      := rfl
  | (bit0 a) := rfl
  | (bit1 a) := rfl

  theorem lt_of_lt_bit0_bit0 {a b : pos_num} (H : bit0 a < bit0 b) : a < b := H
  theorem lt_of_lt_bit0_bit1 {a b : pos_num} (H : bit1 a < bit0 b) : a < b := H
  theorem lt_of_lt_bit1_bit1 {a b : pos_num} (H : bit1 a < bit1 b) : a < b := H
  theorem lt_of_lt_bit1_bit0 {a b : pos_num} (H : bit0 a < bit1 b) : a < succ b := H

  theorem lt_bit0_bit0_eq_lt (a b : pos_num) : lt (bit0 a) (bit0 b) = lt a b :=
  rfl

  theorem lt_bit1_bit1_eq_lt (a b : pos_num) : lt (bit1 a) (bit1 b) = lt a b :=
  rfl

  theorem lt_bit1_bit0_eq_lt (a b : pos_num) : lt (bit1 a) (bit0 b) = lt a b :=
  rfl

  theorem lt_bit0_bit1_eq_lt_succ (a b : pos_num) : lt (bit0 a) (bit1 b) = lt a (succ b) :=
  rfl

  theorem lt_irrefl : ∀ (a : pos_num), a ≮ a
  | one      := rfl
  | (bit0 a) :=
    begin
      rewrite lt_bit0_bit0_eq_lt, apply lt_irrefl
    end
  | (bit1 a) :=
    begin
      rewrite lt_bit1_bit1_eq_lt, apply lt_irrefl
    end

  theorem ne_of_lt_eq_tt : ∀ {a b : pos_num}, a < b → a = b → false
  | one      ⌞one⌟      H₁ (eq.refl one)      := absurd H₁ ff_ne_tt
  | (bit0 a) ⌞(bit0 a)⌟ H₁ (eq.refl (bit0 a)) :=
    begin
      rewrite lt_bit0_bit0_eq_lt at H₁,
      apply ne_of_lt_eq_tt H₁ (eq.refl a)
    end
  | (bit1 a) ⌞(bit1 a)⌟ H₁ (eq.refl (bit1 a)) :=
    begin
      rewrite lt_bit1_bit1_eq_lt at H₁,
      apply ne_of_lt_eq_tt H₁ (eq.refl a)
    end

  theorem lt_base : ∀ a : pos_num, a < succ a
  | one      := rfl
  | (bit0 a) :=
    begin
      rewrite [succ_bit0, lt_bit0_bit1_eq_lt_succ],
      apply lt_base
    end
  | (bit1 a) :=
    begin
      rewrite [succ_bit1, lt_bit1_bit0_eq_lt],
      apply lt_base
    end

  theorem lt_step : ∀ {a b : pos_num}, a < b → a < succ b
  | one      one      H := rfl
  | one      (bit0 b) H := rfl
  | one      (bit1 b) H := rfl
  | (bit0 a) one      H := absurd H ff_ne_tt
  | (bit0 a) (bit0 b) H :=
    begin
      rewrite [succ_bit0, lt_bit0_bit1_eq_lt_succ, lt_bit0_bit0_eq_lt at H],
      apply lt_step H
    end
  | (bit0 a) (bit1 b) H :=
    begin
      rewrite [succ_bit1, lt_bit0_bit0_eq_lt, lt_bit0_bit1_eq_lt_succ at H],
      exact H
    end
  | (bit1 a) one      H := absurd H ff_ne_tt
  | (bit1 a) (bit0 b) H :=
    begin
      rewrite [succ_bit0, lt_bit1_bit1_eq_lt, lt_bit1_bit0_eq_lt at H],
      exact H
    end
  | (bit1 a) (bit1 b) H :=
    begin
      rewrite [succ_bit1, lt_bit1_bit0_eq_lt, lt_bit1_bit1_eq_lt at H],
      apply lt_step H
    end

  theorem lt_of_lt_succ_succ : ∀ {a b : pos_num}, succ a < succ b → a < b
  | one      one      H := absurd H ff_ne_tt
  | one      (bit0 b) H := rfl
  | one      (bit1 b) H := rfl
  | (bit0 a) one      H :=
    begin
      rewrite [succ_bit0 at H, succ_one at H, lt_bit1_bit0_eq_lt at H],
      apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff a) H
    end
  | (bit0 a) (bit0 b) H := by exact H
  | (bit0 a) (bit1 b) H := by exact H
  | (bit1 a) one      H :=
    begin
      rewrite [succ_bit1 at H, succ_one at H, lt_bit0_bit0_eq_lt at H],
      apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff (succ a)) H
    end
  | (bit1 a) (bit0 b) H :=
    begin
      rewrite [succ_bit1 at H, succ_bit0 at H, lt_bit0_bit1_eq_lt_succ at H],
      rewrite lt_bit1_bit0_eq_lt,
      apply lt_of_lt_succ_succ H
    end
  | (bit1 a) (bit1 b) H :=
    begin
      rewrite [lt_bit1_bit1_eq_lt, *succ_bit1 at H, lt_bit0_bit0_eq_lt at H],
      apply lt_of_lt_succ_succ H
    end

  theorem lt_succ_succ : ∀ {a b : pos_num}, a < b → succ a < succ b
  | one      one      H := absurd H ff_ne_tt
  | one      (bit0 b) H :=
    begin
      rewrite [succ_bit0, succ_one, lt_bit0_bit1_eq_lt_succ],
      apply lt_one_succ_eq_tt
    end
  | one      (bit1 b) H :=
    begin
      rewrite [succ_one, succ_bit1, lt_bit0_bit0_eq_lt],
      apply lt_one_succ_eq_tt
    end
  | (bit0 a) one      H := absurd H ff_ne_tt
  | (bit0 a) (bit0 b) H := by exact H
  | (bit0 a) (bit1 b) H := by exact H
  | (bit1 a) one      H := absurd H ff_ne_tt
  | (bit1 a) (bit0 b) H :=
    begin
      rewrite [succ_bit1, succ_bit0, lt_bit0_bit1_eq_lt_succ, lt_bit1_bit0_eq_lt at H],
      apply lt_succ_succ H
    end
  | (bit1 a) (bit1 b) H :=
    begin
      rewrite [lt_bit1_bit1_eq_lt at H, *succ_bit1, lt_bit0_bit0_eq_lt],
      apply lt_succ_succ H
    end

  theorem lt_of_lt_succ : ∀ {a b : pos_num}, succ a < b → a < b
  | one      one      H := absurd_of_eq_ff_of_eq_tt !lt_one_right_eq_ff H
  | one      (bit0 b) H := rfl
  | one      (bit1 b) H := rfl
  | (bit0 a) one      H := absurd_of_eq_ff_of_eq_tt !lt_one_right_eq_ff H
  | (bit0 a) (bit0 b) H := by exact H
  | (bit0 a) (bit1 b) H :=
    begin
      rewrite [succ_bit0 at H, lt_bit1_bit1_eq_lt at H, lt_bit0_bit1_eq_lt_succ],
      apply lt_step H
    end
  | (bit1 a) one      H := absurd_of_eq_ff_of_eq_tt !lt_one_right_eq_ff H
  | (bit1 a) (bit0 b) H :=
    begin
      rewrite [lt_bit1_bit0_eq_lt, succ_bit1 at H, lt_bit0_bit0_eq_lt at H],
      apply lt_of_lt_succ H
    end
  | (bit1 a) (bit1 b) H :=
    begin
      rewrite [succ_bit1 at H, lt_bit0_bit1_eq_lt_succ at H, lt_bit1_bit1_eq_lt],
      apply lt_of_lt_succ_succ H
    end

  theorem lt_of_lt_succ_of_ne : ∀ {a b : pos_num}, a < succ b → a ≠ b → a < b
  | one      one      H₁ H₂ := absurd rfl H₂
  | one      (bit0 b) H₁ H₂ := rfl
  | one      (bit1 b) H₁ H₂ := rfl
  | (bit0 a) one      H₁ H₂ :=
  begin
    rewrite [succ_one at H₁, lt_bit0_bit0_eq_lt at H₁],
    apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁
  end
  | (bit0 a) (bit0 b) H₁ H₂ :=
    begin
      rewrite [lt_bit0_bit0_eq_lt, succ_bit0 at H₁, lt_bit0_bit1_eq_lt_succ at H₁],
      apply lt_of_lt_succ_of_ne H₁ (ne_of_bit0_ne_bit0 H₂)
    end
  | (bit0 a) (bit1 b) H₁ H₂ :=
    begin
      rewrite [succ_bit1 at H₁, lt_bit0_bit0_eq_lt at H₁, lt_bit0_bit1_eq_lt_succ],
      exact H₁
    end
  | (bit1 a) one      H₁ H₂ :=
    begin
      rewrite [succ_one at H₁, lt_bit1_bit0_eq_lt at H₁],
      apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁
    end
  | (bit1 a) (bit0 b) H₁ H₂ :=
    begin
      rewrite [succ_bit0 at H₁, lt_bit1_bit1_eq_lt at H₁, lt_bit1_bit0_eq_lt],
      exact H₁
    end
  | (bit1 a) (bit1 b) H₁ H₂ :=
    begin
      rewrite [succ_bit1 at H₁, lt_bit1_bit0_eq_lt at H₁, lt_bit1_bit1_eq_lt],
      apply lt_of_lt_succ_of_ne H₁ (ne_of_bit1_ne_bit1 H₂)
    end

  theorem lt_trans : ∀ {a b c : pos_num}, a < b → b < c → a < c
  | one      b        (bit0 c) H₁ H₂ := rfl
  | one      b        (bit1 c) H₁ H₂ := rfl
  | a        (bit0 b) one      H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂
  | a        (bit1 b) one      H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂
  | (bit0 a) (bit0 b) (bit0 c) H₁ H₂ :=
    begin
      rewrite lt_bit0_bit0_eq_lt at *, apply lt_trans H₁ H₂
    end
  | (bit0 a) (bit0 b) (bit1 c) H₁ H₂ :=
    begin
      rewrite [lt_bit0_bit1_eq_lt_succ at *, lt_bit0_bit0_eq_lt at H₁],
      apply lt_trans H₁ H₂
    end
  | (bit0 a) (bit1 b) (bit0 c) H₁ H₂ :=
    begin
      rewrite [lt_bit0_bit1_eq_lt_succ at H₁, lt_bit1_bit0_eq_lt at H₂, lt_bit0_bit0_eq_lt],
      apply @by_cases (a = b),
      begin
         intro H, rewrite -H at H₂, exact H₂
      end,
      begin
        intro H,
        apply lt_trans (lt_of_lt_succ_of_ne H₁ H) H₂
      end
    end
  | (bit0 a) (bit1 b) (bit1 c) H₁ H₂ :=
    begin
      rewrite [lt_bit0_bit1_eq_lt_succ at *, lt_bit1_bit1_eq_lt at H₂],
      apply lt_trans H₁ (lt_succ_succ H₂)
    end
  | (bit1 a) (bit0 b) (bit0 c) H₁ H₂ :=
    begin
      rewrite [lt_bit0_bit0_eq_lt at H₂, lt_bit1_bit0_eq_lt at *],
      apply lt_trans H₁ H₂
    end
  | (bit1 a) (bit0 b) (bit1 c) H₁ H₂ :=
    begin
      rewrite [lt_bit1_bit0_eq_lt at H₁, lt_bit0_bit1_eq_lt_succ at H₂, lt_bit1_bit1_eq_lt],
      apply @by_cases (b = c),
      begin
        intro H, rewrite H at H₁, exact H₁
      end,
      begin
        intro H,
        apply lt_trans H₁ (lt_of_lt_succ_of_ne H₂ H)
      end
    end
  | (bit1 a) (bit1 b) (bit0 c) H₁ H₂ :=
    begin
      rewrite [lt_bit1_bit1_eq_lt at H₁, lt_bit1_bit0_eq_lt at H₂, lt_bit1_bit0_eq_lt],
      apply lt_trans H₁ H₂
    end
  | (bit1 a) (bit1 b) (bit1 c) H₁ H₂ :=
    begin
      rewrite lt_bit1_bit1_eq_lt at *,
      apply lt_trans H₁ H₂
    end

  theorem lt_antisymm : ∀ {a b : pos_num}, a < b → b ≮ a
  | one      one      H := rfl
  | one      (bit0 b) H := rfl
  | one      (bit1 b) H := rfl
  | (bit0 a) one      H := absurd H ff_ne_tt
  | (bit0 a) (bit0 b) H :=
    begin
      rewrite lt_bit0_bit0_eq_lt at *,
      apply lt_antisymm H
    end
  | (bit0 a) (bit1 b) H :=
    begin
      rewrite lt_bit1_bit0_eq_lt,
      rewrite lt_bit0_bit1_eq_lt_succ at H,
      have H₁ : succ b ≮ a, from lt_antisymm H,
      apply eq_ff_of_ne_tt,
        intro H₂,
        apply @by_cases (succ b = a),
        show succ b = a → false,
        begin
          intro Hp,
          rewrite -Hp at H,
          apply absurd_of_eq_ff_of_eq_tt (lt_irrefl (succ b)) H
        end,
        show succ b ≠ a → false,
        begin
          intro Hn,
          have H₃ : succ b < succ a, from lt_succ_succ H₂,
          have H₄ : succ b < a, from lt_of_lt_succ_of_ne H₃ Hn,
          apply absurd_of_eq_ff_of_eq_tt H₁ H₄
        end,
    end
  | (bit1 a) one      H := absurd H ff_ne_tt
  | (bit1 a) (bit0 b) H :=
    begin
      rewrite lt_bit0_bit1_eq_lt_succ,
      rewrite lt_bit1_bit0_eq_lt at H,
      have H₁ : lt b a = ff, from lt_antisymm H,
      apply eq_ff_of_ne_tt,
        intro H₂,
        apply @by_cases (b = a),
        show b = a → false,
        begin
          intro Hp,
          rewrite -Hp at H,
          apply absurd_of_eq_ff_of_eq_tt (lt_irrefl b) H
        end,
        show b ≠ a → false,
        begin
          intro Hn,
          have H₃ : b < a, from lt_of_lt_succ_of_ne H₂ Hn,
          apply absurd_of_eq_ff_of_eq_tt H₁ H₃
        end,
      end
  | (bit1 a) (bit1 b) H :=
    begin
      rewrite lt_bit1_bit1_eq_lt at *,
      apply lt_antisymm H
    end

  local notation a ≤ b := (le a b = tt)

  theorem le_refl : ∀ a : pos_num, a ≤ a :=
  lt_base

  theorem le_eq_lt_succ {a b : pos_num} : le a b = lt a (succ b) :=
  rfl

  theorem not_lt_of_le : ∀ {a b : pos_num}, a ≤ b → b < a → false
  | one      one      H₁ H₂ := absurd H₂ ff_ne_tt
  | one      (bit0 b) H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂
  | one      (bit1 b) H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂
  | (bit0 a) one      H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at H₁, succ_one at H₁, lt_bit0_bit0_eq_lt at H₁],
      apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁
    end
  | (bit0 a) (bit0 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at H₁, succ_bit0 at H₁, lt_bit0_bit1_eq_lt_succ at H₁],
      rewrite [lt_bit0_bit0_eq_lt at H₂],
      apply not_lt_of_le H₁ H₂
    end
  | (bit0 a) (bit1 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at H₁, succ_bit1 at H₁, lt_bit0_bit0_eq_lt at H₁],
      rewrite [lt_bit1_bit0_eq_lt at H₂],
      apply not_lt_of_le H₁ H₂
    end
  | (bit1 a) one      H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at H₁, succ_one at H₁, lt_bit1_bit0_eq_lt at H₁],
      apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁
    end
  | (bit1 a) (bit0 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at H₁, succ_bit0 at H₁, lt_bit1_bit1_eq_lt at H₁],
      rewrite lt_bit0_bit1_eq_lt_succ at H₂,
      have H₃ : a < succ b, from lt_step H₁,
      apply @by_cases (b = a),
      begin
        intro Hba, rewrite -Hba at H₁,
        apply absurd_of_eq_ff_of_eq_tt (lt_irrefl b) H₁
      end,
      begin
        intro Hnba,
        have H₄ : b < a, from lt_of_lt_succ_of_ne H₂ Hnba,
        apply not_lt_of_le H₃ H₄
      end
    end
  | (bit1 a) (bit1 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at H₁, succ_bit1 at H₁, lt_bit1_bit0_eq_lt at H₁],
      rewrite [lt_bit1_bit1_eq_lt at H₂],
      apply not_lt_of_le H₁ H₂
    end

  theorem le_antisymm : ∀ {a b : pos_num}, a ≤ b → b ≤ a → a = b
  | one      one      H₁ H₂ := rfl
  | one      (bit0 b) H₁ H₂ :=
    by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff b) H₂
  | one      (bit1 b) H₁ H₂ :=
    by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff b) H₂
  | (bit0 a) one      H₁ H₂ :=
    by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff a) H₁
  | (bit0 a) (bit0 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at *, succ_bit0 at *, lt_bit0_bit1_eq_lt_succ at *],
      have H : a = b, from le_antisymm H₁ H₂,
      rewrite H
    end
  | (bit0 a) (bit1 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at *, succ_bit1 at H₁, succ_bit0 at H₂],
      rewrite [lt_bit0_bit0_eq_lt at H₁, lt_bit1_bit1_eq_lt at H₂],
      apply false.rec _ (not_lt_of_le H₁ H₂)
    end
  | (bit1 a) one      H₁ H₂ :=
    by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff a) H₁
  | (bit1 a) (bit0 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at *, succ_bit0 at H₁, succ_bit1 at H₂],
      rewrite [lt_bit1_bit1_eq_lt at H₁, lt_bit0_bit0_eq_lt at H₂],
      apply false.rec _ (not_lt_of_le H₂ H₁)
    end
  | (bit1 a) (bit1 b) H₁ H₂ :=
    begin
      rewrite [le_eq_lt_succ at *, succ_bit1 at *, lt_bit1_bit0_eq_lt at *],
      have H : a = b, from le_antisymm H₁ H₂,
      rewrite H
    end

  theorem le_trans {a b c : pos_num} : a ≤ b → b ≤ c → a ≤ c :=
  begin
    intro H₁ H₂,
    rewrite [le_eq_lt_succ at *],
    apply @by_cases (a = b),
    begin
      intro Hab, rewrite Hab, exact H₂
    end,
    begin
      intro Hnab,
      have Haltb : a < b, from lt_of_lt_succ_of_ne H₁ Hnab,
      apply lt_trans Haltb H₂
    end,
  end

end pos_num

namespace num
  open pos_num

  theorem decidable_eq [instance] : ∀ (a b : num), decidable (a = b)
  | zero zero       := inl rfl
  | zero (pos b)    := inr (by contradiction)
  | (pos a) zero    := inr (by contradiction)
  | (pos a) (pos b) :=
    if H : a = b then inl (by rewrite H) else inr (suppose pos a = pos b, begin injection this, contradiction end)
end num


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.normed_space.hahn_banach.extension
import analysis.normed_space.is_R_or_C
import analysis.locally_convex.polar

/-!
# The topological dual of a normed space

In this file we define the topological dual `normed_space.dual` of a normed space, and the
continuous linear map `normed_space.inclusion_in_double_dual` from a normed space into its double
dual.

For base field `𝕜 = ℝ` or `𝕜 = ℂ`, this map is actually an isometric embedding; we provide a
version `normed_space.inclusion_in_double_dual_li` of the map which is of type a bundled linear
isometric embedding, `E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E))`.

Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
theory for `semi_normed_group` and we specialize to `normed_group` when needed.

## Main definitions

* `inclusion_in_double_dual` and `inclusion_in_double_dual_li` are the inclusion of a normed space
  in its double dual, considered as a bounded linear map and as a linear isometry, respectively.
* `polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals `x'` for which
  `∥x' z∥ ≤ 1` for every `z ∈ s`.

## Tags

dual
-/

noncomputable theory
open_locale classical topological_space
universes u v

namespace normed_space

section general
variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
variables (E : Type*) [semi_normed_group E] [normed_space 𝕜 E]
variables (F : Type*) [normed_group F] [normed_space 𝕜 F]

/-- The topological dual of a seminormed space `E`. -/
@[derive [inhabited, semi_normed_group, normed_space 𝕜]] def dual := E →L[𝕜] 𝕜

instance : continuous_linear_map_class (dual 𝕜 E) 𝕜 E 𝕜 :=
continuous_linear_map.continuous_semilinear_map_class

instance : has_coe_to_fun (dual 𝕜 E) (λ _, E → 𝕜) := continuous_linear_map.to_fun

instance : normed_group (dual 𝕜 F) := continuous_linear_map.to_normed_group

instance [finite_dimensional 𝕜 E] : finite_dimensional 𝕜 (dual 𝕜 E) :=
continuous_linear_map.finite_dimensional

/-- The inclusion of a normed space in its double (topological) dual, considered
   as a bounded linear map. -/
def inclusion_in_double_dual : E →L[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
continuous_linear_map.apply 𝕜 𝕜

@[simp] lemma dual_def (x : E) (f : dual 𝕜 E) : inclusion_in_double_dual 𝕜 E x f = f x := rfl

lemma inclusion_in_double_dual_norm_eq :
  ∥inclusion_in_double_dual 𝕜 E∥ = ∥(continuous_linear_map.id 𝕜 (dual 𝕜 E))∥ :=
continuous_linear_map.op_norm_flip _

lemma inclusion_in_double_dual_norm_le : ∥inclusion_in_double_dual 𝕜 E∥ ≤ 1 :=
by { rw inclusion_in_double_dual_norm_eq, exact continuous_linear_map.norm_id_le }

lemma double_dual_bound (x : E) : ∥(inclusion_in_double_dual 𝕜 E) x∥ ≤ ∥x∥ :=
by simpa using continuous_linear_map.le_of_op_norm_le _ (inclusion_in_double_dual_norm_le 𝕜 E) x

/-- The dual pairing as a bilinear form. -/
def dual_pairing : (dual 𝕜 E) →ₗ[𝕜] E →ₗ[𝕜] 𝕜 := continuous_linear_map.coe_lm 𝕜

@[simp] lemma dual_pairing_apply {v : dual 𝕜 E} {x : E} : dual_pairing 𝕜 E v x = v x := rfl

lemma dual_pairing_separating_left : (dual_pairing 𝕜 E).separating_left :=
begin
  rw [linear_map.separating_left_iff_ker_eq_bot, linear_map.ker_eq_bot],
  exact continuous_linear_map.coe_injective,
end

end general

section bidual_isometry

variables (𝕜 : Type v) [is_R_or_C 𝕜]
  {E : Type u} [normed_group E] [normed_space 𝕜 E]

/-- If one controls the norm of every `f x`, then one controls the norm of `x`.
    Compare `continuous_linear_map.op_norm_le_bound`. -/
lemma norm_le_dual_bound (x : E) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ (f : dual 𝕜 E), ∥f x∥ ≤ M * ∥f∥) :
  ∥x∥ ≤ M :=
begin
  classical,
  by_cases h : x = 0,
  { simp only [h, hMp, norm_zero] },
  { obtain ⟨f, hf₁, hfx⟩ : ∃ f : E →L[𝕜] 𝕜, ∥f∥ = 1 ∧ f x = ∥x∥ := exists_dual_vector 𝕜 x h,
    calc ∥x∥ = ∥(∥x∥ : 𝕜)∥ : is_R_or_C.norm_coe_norm.symm
    ... = ∥f x∥ : by rw hfx
    ... ≤ M * ∥f∥ : hM f
    ... = M : by rw [hf₁, mul_one] }
end

lemma eq_zero_of_forall_dual_eq_zero {x : E} (h : ∀ f : dual 𝕜 E, f x = (0 : 𝕜)) : x = 0 :=
norm_le_zero_iff.mp (norm_le_dual_bound 𝕜 x le_rfl (λ f, by simp [h f]))

lemma eq_zero_iff_forall_dual_eq_zero (x : E) : x = 0 ↔ ∀ g : dual 𝕜 E, g x = 0 :=
⟨λ hx, by simp [hx], λ h, eq_zero_of_forall_dual_eq_zero 𝕜 h⟩

/-- See also `geometric_hahn_banach_point_point`. -/
lemma eq_iff_forall_dual_eq {x y : E} :
  x = y ↔ ∀ g : dual 𝕜 E, g x = g y :=
begin
  rw [← sub_eq_zero, eq_zero_iff_forall_dual_eq_zero 𝕜 (x - y)],
  simp [sub_eq_zero],
end

/-- The inclusion of a normed space in its double dual is an isometry onto its image.-/
def inclusion_in_double_dual_li : E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
{ norm_map' := begin
    intros x,
    apply le_antisymm,
    { exact double_dual_bound 𝕜 E x },
    rw continuous_linear_map.norm_def,
    refine le_cInf continuous_linear_map.bounds_nonempty _,
    rintros c ⟨hc1, hc2⟩,
    exact norm_le_dual_bound 𝕜 x hc1 hc2
  end,
  .. inclusion_in_double_dual 𝕜 E }

end bidual_isometry

section polar_sets

open metric set normed_space

/-- Given a subset `s` in a normed space `E` (over a field `𝕜`), the polar
`polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals which
evaluate to something of norm at most one at all points `z ∈ s`. -/
def polar (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
  {E : Type*} [semi_normed_group E] [normed_space 𝕜 E] : set E → set (dual 𝕜 E) :=
(dual_pairing 𝕜 E).flip.polar

variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
variables {E : Type*} [semi_normed_group E] [normed_space 𝕜 E]

lemma mem_polar_iff {x' : dual 𝕜 E} (s : set E) : x' ∈ polar 𝕜 s ↔ ∀ z ∈ s, ∥x' z∥ ≤ 1 := iff.rfl

@[simp] lemma polar_univ : polar 𝕜 (univ : set E) = {(0 : dual 𝕜 E)} :=
(dual_pairing 𝕜 E).flip.polar_univ
  (linear_map.flip_separating_right.mpr (dual_pairing_separating_left 𝕜 E))

lemma is_closed_polar (s : set E) : is_closed (polar 𝕜 s) :=
begin
  dunfold normed_space.polar,
  simp only [linear_map.polar_eq_Inter, linear_map.flip_apply],
  refine is_closed_bInter (λ z hz, _),
  exact is_closed_Iic.preimage (continuous_linear_map.apply 𝕜 𝕜 z).continuous.norm
end

@[simp] lemma polar_closure (s : set E) : polar 𝕜 (closure s) = polar 𝕜 s :=
((dual_pairing 𝕜 E).flip.polar_antitone subset_closure).antisymm $
  (dual_pairing 𝕜 E).flip.polar_gc.l_le $
  closure_minimal ((dual_pairing 𝕜 E).flip.polar_gc.le_u_l s) $
  by simpa [linear_map.flip_flip]
    using (is_closed_polar _ _).preimage (inclusion_in_double_dual 𝕜 E).continuous

variables {𝕜}

/-- If `x'` is a dual element such that the norms `∥x' z∥` are bounded for `z ∈ s`, then a
small scalar multiple of `x'` is in `polar 𝕜 s`. -/
lemma smul_mem_polar {s : set E} {x' : dual 𝕜 E} {c : 𝕜}
  (hc : ∀ z, z ∈ s → ∥ x' z ∥ ≤ ∥c∥) : c⁻¹ • x' ∈ polar 𝕜 s :=
begin
  by_cases c_zero : c = 0, { simp only [c_zero, inv_zero, zero_smul],
    exact (dual_pairing 𝕜 E).flip.zero_mem_polar _ },
  have eq : ∀ z, ∥ c⁻¹ • (x' z) ∥ = ∥ c⁻¹ ∥ * ∥ x' z ∥ := λ z, norm_smul c⁻¹ _,
  have le : ∀ z, z ∈ s → ∥ c⁻¹ • (x' z) ∥ ≤ ∥ c⁻¹ ∥ * ∥ c ∥,
  { intros z hzs,
    rw eq z,
    apply mul_le_mul (le_of_eq rfl) (hc z hzs) (norm_nonneg _) (norm_nonneg _), },
  have cancel : ∥ c⁻¹ ∥ * ∥ c ∥ = 1,
  by simp only [c_zero, norm_eq_zero, ne.def, not_false_iff,
                inv_mul_cancel, norm_inv],
  rwa cancel at le,
end

lemma polar_ball_subset_closed_ball_div {c : 𝕜} (hc : 1 < ∥c∥) {r : ℝ} (hr : 0 < r) :
  polar 𝕜 (ball (0 : E) r) ⊆ closed_ball (0 : dual 𝕜 E) (∥c∥ / r) :=
begin
  intros x' hx',
  rw mem_polar_iff at hx',
  simp only [polar, mem_set_of_eq, mem_closed_ball_zero_iff, mem_ball_zero_iff] at *,
  have hcr : 0 < ∥c∥ / r, from div_pos (zero_lt_one.trans hc) hr,
  refine continuous_linear_map.op_norm_le_of_shell hr hcr.le hc (λ x h₁ h₂, _),
  calc ∥x' x∥ ≤ 1 : hx' _ h₂
  ... ≤ (∥c∥ / r) * ∥x∥ : (inv_pos_le_iff_one_le_mul' hcr).1 (by rwa inv_div)
end

variables (𝕜)

lemma closed_ball_inv_subset_polar_closed_ball {r : ℝ} :
  closed_ball (0 : dual 𝕜 E) r⁻¹ ⊆ polar 𝕜 (closed_ball (0 : E) r) :=
λ x' hx' x hx,
calc ∥x' x∥ ≤ ∥x'∥ * ∥x∥ : x'.le_op_norm x
... ≤ r⁻¹ * r :
  mul_le_mul (mem_closed_ball_zero_iff.1 hx') (mem_closed_ball_zero_iff.1 hx)
    (norm_nonneg _) (dist_nonneg.trans hx')
... = r / r : inv_mul_eq_div _ _
... ≤ 1 : div_self_le_one r

/-- The `polar` of closed ball in a normed space `E` is the closed ball of the dual with
inverse radius. -/
lemma polar_closed_ball
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] {r : ℝ} (hr : 0 < r) :
  polar 𝕜 (closed_ball (0 : E) r) = closed_ball (0 : dual 𝕜 E) r⁻¹ :=
begin
  refine subset.antisymm _ (closed_ball_inv_subset_polar_closed_ball _),
  intros x' h,
  simp only [mem_closed_ball_zero_iff],
  refine continuous_linear_map.op_norm_le_of_ball hr (inv_nonneg.mpr hr.le) (λ z hz, _),
  simpa only [one_div] using linear_map.bound_of_ball_bound' hr 1 x'.to_linear_map h z
end

/-- Given a neighborhood `s` of the origin in a normed space `E`, the dual norms
of all elements of the polar `polar 𝕜 s` are bounded by a constant. -/
lemma bounded_polar_of_mem_nhds_zero {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  bounded (polar 𝕜 s) :=
begin
  obtain ⟨a, ha⟩ : ∃ a : 𝕜, 1 < ∥a∥ := normed_field.exists_one_lt_norm 𝕜,
  obtain ⟨r, r_pos, r_ball⟩ : ∃ (r : ℝ) (hr : 0 < r), ball 0 r ⊆ s :=
    metric.mem_nhds_iff.1 s_nhd,
  exact bounded_closed_ball.mono (((dual_pairing 𝕜 E).flip.polar_antitone r_ball).trans $
    polar_ball_subset_closed_ball_div ha r_pos)
end

end polar_sets

end normed_space


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

! This file was ported from Lean 3 source module analysis.calculus.bump_function_inner
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.IteratedDeriv
import Mathbin.Analysis.InnerProductSpace.EuclideanDist
import Mathbin.MeasureTheory.Function.LocallyIntegrable
import Mathbin.MeasureTheory.Integral.SetIntegral

/-!
# Infinitely smooth bump function

In this file we construct several infinitely smooth functions with properties that an analytic
function cannot have:

* `exp_neg_inv_glue` is equal to zero for `x ≤ 0` and is strictly positive otherwise; it is given by
  `x ↦ exp (-1/x)` for `x > 0`;

* `real.smooth_transition` is equal to zero for `x ≤ 0` and is equal to one for `x ≥ 1`; it is given
  by `exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x))`;

* `f : cont_diff_bump c`, where `c` is a point in a real vector space, is
  a bundled smooth function such that

  - `f` is equal to `1` in `metric.closed_ball c f.r`;
  - `support f = metric.ball c f.R`;
  - `0 ≤ f x ≤ 1` for all `x`.

  The structure `cont_diff_bump` contains the data required to construct the
  function: real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available
  through `coe_fn`.

* If `f : cont_diff_bump c` and `μ` is a measure on the domain of `f`, then `f.normed μ`
  is a smooth bump function with integral `1` w.r.t. `μ`.
-/

noncomputable section

open Classical Topology

open Polynomial Real Filter Set Function

open Polynomial

/-- `exp_neg_inv_glue` is the real function given by `x ↦ exp (-1/x)` for `x > 0` and `0`
for `x ≤ 0`. It is a basic building block to construct smooth partitions of unity. Its main property
is that it vanishes for `x ≤ 0`, it is positive for `x > 0`, and the junction between the two
behaviors is flat enough to retain smoothness. The fact that this function is `C^∞` is proved in
`exp_neg_inv_glue.smooth`. -/
def expNegInvGlue (x : ℝ) : ℝ :=
  if x ≤ 0 then 0 else exp (-x⁻¹)
#align exp_neg_inv_glue expNegInvGlue

namespace expNegInvGlue

/-- Our goal is to prove that `exp_neg_inv_glue` is `C^∞`. For this, we compute its successive
derivatives for `x > 0`. The `n`-th derivative is of the form `P_aux n (x) exp(-1/x) / x^(2 n)`,
where `P_aux n` is computed inductively. -/
noncomputable def pAux : ℕ → ℝ[X]
  | 0 => 1
  | n + 1 => X ^ 2 * (P_aux n).derivative + (1 - C ↑(2 * n) * X) * P_aux n
#align exp_neg_inv_glue.P_aux expNegInvGlue.pAux

/-- Formula for the `n`-th derivative of `exp_neg_inv_glue`, as an auxiliary function `f_aux`. -/
def fAux (n : ℕ) (x : ℝ) : ℝ :=
  if x ≤ 0 then 0 else (pAux n).eval x * exp (-x⁻¹) / x ^ (2 * n)
#align exp_neg_inv_glue.f_aux expNegInvGlue.fAux

/-- The `0`-th auxiliary function `f_aux 0` coincides with `exp_neg_inv_glue`, by definition. -/
theorem fAux_zero_eq : fAux 0 = expNegInvGlue :=
  by
  ext x
  by_cases h : x ≤ 0
  · simp [expNegInvGlue, f_aux, h]
  · simp [h, expNegInvGlue, f_aux, ne_of_gt (not_le.1 h), P_aux]
#align exp_neg_inv_glue.f_aux_zero_eq expNegInvGlue.fAux_zero_eq

/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n`
(given in this statement in unfolded form) is the `n+1`-th auxiliary function, since
the polynomial `P_aux (n+1)` was chosen precisely to ensure this. -/
theorem f_aux_deriv (n : ℕ) (x : ℝ) (hx : x ≠ 0) :
    HasDerivAt (fun x => (pAux n).eval x * exp (-x⁻¹) / x ^ (2 * n))
      ((pAux (n + 1)).eval x * exp (-x⁻¹) / x ^ (2 * (n + 1))) x :=
  by
  simp only [P_aux, eval_add, eval_sub, eval_mul, eval_pow, eval_X, eval_C, eval_one]
  convert(((P_aux n).HasDerivAt x).mul ((has_deriv_at_exp _).comp x (hasDerivAt_inv hx).neg)).div
      (hasDerivAt_pow (2 * n) x) (pow_ne_zero _ hx) using
    1
  rw [div_eq_div_iff]
  · have := pow_ne_zero 2 hx
    field_simp only
    cases n
    · simp only [MulZeroClass.mul_zero, Nat.cast_zero, mul_one]
      ring
    · rw [(id rfl : 2 * n.succ - 1 = 2 * n + 1)]
      ring
  all_goals apply_rules [pow_ne_zero]
#align exp_neg_inv_glue.f_aux_deriv expNegInvGlue.f_aux_deriv

/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n`
is the `n+1`-th auxiliary function. -/
theorem fAux_deriv_pos (n : ℕ) (x : ℝ) (hx : 0 < x) :
    HasDerivAt (fAux n) ((pAux (n + 1)).eval x * exp (-x⁻¹) / x ^ (2 * (n + 1))) x :=
  by
  apply (f_aux_deriv n x (ne_of_gt hx)).congr_of_eventuallyEq
  filter_upwards [lt_mem_nhds hx]with _ hy
  simp [f_aux, hy.not_le]
#align exp_neg_inv_glue.f_aux_deriv_pos expNegInvGlue.fAux_deriv_pos

/-- To get differentiability at `0` of the auxiliary functions, we need to know that their limit
is `0`, to be able to apply general differentiability extension theorems. This limit is checked in
this lemma. -/
theorem f_aux_limit (n : ℕ) :
    Tendsto (fun x => (pAux n).eval x * exp (-x⁻¹) / x ^ (2 * n)) (𝓝[>] 0) (𝓝 0) :=
  by
  have A : tendsto (fun x => (P_aux n).eval x) (𝓝[>] 0) (𝓝 ((P_aux n).eval 0)) :=
    (P_aux n).ContinuousWithinAt
  have B : tendsto (fun x => exp (-x⁻¹) / x ^ (2 * n)) (𝓝[>] 0) (𝓝 0) :=
    by
    convert(tendsto_pow_mul_exp_neg_at_top_nhds_0 (2 * n)).comp tendsto_inv_zero_atTop
    ext x
    field_simp
  convert A.mul B <;> simp [mul_div_assoc]
#align exp_neg_inv_glue.f_aux_limit expNegInvGlue.f_aux_limit

/-- Deduce from the limiting behavior at `0` of its derivative and general differentiability
extension theorems that the auxiliary function `f_aux n` is differentiable at `0`,
with derivative `0`. -/
theorem fAux_deriv_zero (n : ℕ) : HasDerivAt (fAux n) 0 0 :=
  by
  -- we check separately differentiability on the left and on the right
  have A : HasDerivWithinAt (f_aux n) (0 : ℝ) (Iic 0) 0 :=
    by
    apply (hasDerivAt_const (0 : ℝ) (0 : ℝ)).HasDerivWithinAt.congr
    · intro y hy
      simp at hy
      simp [f_aux, hy]
    · simp [f_aux, le_refl]
  have B : HasDerivWithinAt (f_aux n) (0 : ℝ) (Ici 0) 0 :=
    by
    have diff : DifferentiableOn ℝ (f_aux n) (Ioi 0) := fun x hx =>
      (f_aux_deriv_pos n x hx).DifferentiableAt.DifferentiableWithinAt
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff _ self_mem_nhdsWithin
    · refine' (f_aux_limit (n + 1)).congr' _
      apply mem_of_superset self_mem_nhdsWithin fun x hx => _
      simp [(f_aux_deriv_pos n x hx).deriv]
    · have : f_aux n 0 = 0 := by simp [f_aux, le_refl]
      simp only [ContinuousWithinAt, this]
      refine' (f_aux_limit n).congr' _
      apply mem_of_superset self_mem_nhdsWithin fun x hx => _
      have : ¬x ≤ 0 := by simpa using hx
      simp [f_aux, this]
  simpa using A.union B
#align exp_neg_inv_glue.f_aux_deriv_zero expNegInvGlue.fAux_deriv_zero

/-- At every point, the auxiliary function `f_aux n` has a derivative which is
equal to `f_aux (n+1)`. -/
theorem fAux_hasDerivAt (n : ℕ) (x : ℝ) : HasDerivAt (fAux n) (fAux (n + 1) x) x :=
  by
  -- check separately the result for `x < 0`, where it is trivial, for `x > 0`, where it is done
  -- in `f_aux_deriv_pos`, and for `x = 0`, done in
  -- `f_aux_deriv_zero`.
  rcases lt_trichotomy x 0 with (hx | hx | hx)
  · have : f_aux (n + 1) x = 0 := by simp [f_aux, le_of_lt hx]
    rw [this]
    apply (hasDerivAt_const x (0 : ℝ)).congr_of_eventuallyEq
    filter_upwards [gt_mem_nhds hx]with _ hy
    simp [f_aux, hy.le]
  · have : f_aux (n + 1) 0 = 0 := by simp [f_aux, le_refl]
    rw [hx, this]
    exact f_aux_deriv_zero n
  · have : f_aux (n + 1) x = (P_aux (n + 1)).eval x * exp (-x⁻¹) / x ^ (2 * (n + 1)) := by
      simp [f_aux, not_le_of_gt hx]
    rw [this]
    exact f_aux_deriv_pos n x hx
#align exp_neg_inv_glue.f_aux_has_deriv_at expNegInvGlue.fAux_hasDerivAt

/-- The successive derivatives of the auxiliary function `f_aux 0` are the
functions `f_aux n`, by induction. -/
theorem fAux_iteratedDeriv (n : ℕ) : iteratedDeriv n (fAux 0) = fAux n :=
  by
  induction' n with n IH
  · simp
  · simp [iteratedDeriv_succ, IH]
    ext x
    exact (f_aux_has_deriv_at n x).deriv
#align exp_neg_inv_glue.f_aux_iterated_deriv expNegInvGlue.fAux_iteratedDeriv

/-- The function `exp_neg_inv_glue` is smooth. -/
protected theorem contDiff {n} : ContDiff ℝ n expNegInvGlue :=
  by
  rw [← f_aux_zero_eq]
  apply contDiff_of_differentiable_iteratedDeriv fun m hm => _
  rw [f_aux_iterated_deriv m]
  exact fun x => (f_aux_has_deriv_at m x).DifferentiableAt
#align exp_neg_inv_glue.cont_diff expNegInvGlue.contDiff

/-- The function `exp_neg_inv_glue` vanishes on `(-∞, 0]`. -/
theorem zero_of_nonpos {x : ℝ} (hx : x ≤ 0) : expNegInvGlue x = 0 := by simp [expNegInvGlue, hx]
#align exp_neg_inv_glue.zero_of_nonpos expNegInvGlue.zero_of_nonpos

/-- The function `exp_neg_inv_glue` is positive on `(0, +∞)`. -/
theorem pos_of_pos {x : ℝ} (hx : 0 < x) : 0 < expNegInvGlue x := by
  simp [expNegInvGlue, not_le.2 hx, exp_pos]
#align exp_neg_inv_glue.pos_of_pos expNegInvGlue.pos_of_pos

/-- The function exp_neg_inv_glue` is nonnegative. -/
theorem nonneg (x : ℝ) : 0 ≤ expNegInvGlue x :=
  by
  cases le_or_gt x 0
  · exact ge_of_eq (zero_of_nonpos h)
  · exact le_of_lt (pos_of_pos h)
#align exp_neg_inv_glue.nonneg expNegInvGlue.nonneg

end expNegInvGlue

/-- An infinitely smooth function `f : ℝ → ℝ` such that `f x = 0` for `x ≤ 0`,
`f x = 1` for `1 ≤ x`, and `0 < f x < 1` for `0 < x < 1`. -/
def Real.smoothTransition (x : ℝ) : ℝ :=
  expNegInvGlue x / (expNegInvGlue x + expNegInvGlue (1 - x))
#align real.smooth_transition Real.smoothTransition

namespace Real

namespace SmoothTransition

variable {x : ℝ}

open expNegInvGlue

theorem pos_denom (x) : 0 < expNegInvGlue x + expNegInvGlue (1 - x) :=
  (zero_lt_one.lt_or_lt x).elim (fun hx => add_pos_of_pos_of_nonneg (pos_of_pos hx) (nonneg _))
    fun hx => add_pos_of_nonneg_of_pos (nonneg _) (pos_of_pos <| sub_pos.2 hx)
#align real.smooth_transition.pos_denom Real.smoothTransition.pos_denom

theorem one_of_one_le (h : 1 ≤ x) : smoothTransition x = 1 :=
  (div_eq_one_iff_eq <| (pos_denom x).ne').2 <| by rw [zero_of_nonpos (sub_nonpos.2 h), add_zero]
#align real.smooth_transition.one_of_one_le Real.smoothTransition.one_of_one_le

theorem zero_of_nonpos (h : x ≤ 0) : smoothTransition x = 0 := by
  rw [smooth_transition, zero_of_nonpos h, zero_div]
#align real.smooth_transition.zero_of_nonpos Real.smoothTransition.zero_of_nonpos

@[simp]
protected theorem zero : smoothTransition 0 = 0 :=
  zero_of_nonpos le_rfl
#align real.smooth_transition.zero Real.smoothTransition.zero

@[simp]
protected theorem one : smoothTransition 1 = 1 :=
  one_of_one_le le_rfl
#align real.smooth_transition.one Real.smoothTransition.one

theorem le_one (x : ℝ) : smoothTransition x ≤ 1 :=
  (div_le_one (pos_denom x)).2 <| le_add_of_nonneg_right (nonneg _)
#align real.smooth_transition.le_one Real.smoothTransition.le_one

theorem nonneg (x : ℝ) : 0 ≤ smoothTransition x :=
  div_nonneg (expNegInvGlue.nonneg _) (pos_denom x).le
#align real.smooth_transition.nonneg Real.smoothTransition.nonneg

theorem lt_one_of_lt_one (h : x < 1) : smoothTransition x < 1 :=
  (div_lt_one <| pos_denom x).2 <| lt_add_of_pos_right _ <| pos_of_pos <| sub_pos.2 h
#align real.smooth_transition.lt_one_of_lt_one Real.smoothTransition.lt_one_of_lt_one

theorem pos_of_pos (h : 0 < x) : 0 < smoothTransition x :=
  div_pos (expNegInvGlue.pos_of_pos h) (pos_denom x)
#align real.smooth_transition.pos_of_pos Real.smoothTransition.pos_of_pos

protected theorem contDiff {n} : ContDiff ℝ n smoothTransition :=
  expNegInvGlue.contDiff.div
    (expNegInvGlue.contDiff.add <| expNegInvGlue.contDiff.comp <| contDiff_const.sub contDiff_id)
    fun x => (pos_denom x).ne'
#align real.smooth_transition.cont_diff Real.smoothTransition.contDiff

protected theorem contDiffAt {x n} : ContDiffAt ℝ n smoothTransition x :=
  smoothTransition.contDiff.ContDiffAt
#align real.smooth_transition.cont_diff_at Real.smoothTransition.contDiffAt

protected theorem continuous : Continuous smoothTransition :=
  (@smoothTransition.contDiff 0).Continuous
#align real.smooth_transition.continuous Real.smoothTransition.continuous

end SmoothTransition

end Real

variable {E X : Type _}

/-- `f : cont_diff_bump c`, where `c` is a point in a normed vector space, is a
bundled smooth function such that

- `f` is equal to `1` in `metric.closed_ball c f.r`;
- `support f = metric.ball c f.R`;
- `0 ≤ f x ≤ 1` for all `x`.

The structure `cont_diff_bump` contains the data required to construct the function:
real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through
`coe_fn` when the space is nice enough, i.e., satisfies the `has_cont_diff_bump` typeclass. -/
structure ContDiffBump (c : E) where
  (R r : ℝ)
  r_pos : 0 < r
  r_lt_r : r < R
#align cont_diff_bump ContDiffBump

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The base function from which one will construct a family of bump functions. One could
add more properties if they are useful and satisfied in the examples of inner product spaces
and finite dimensional vector spaces, notably derivative norm control in terms of `R - 1`. -/
@[nolint has_nonempty_instance]
structure ContDiffBumpBase (E : Type _) [NormedAddCommGroup E] [NormedSpace ℝ E] where
  toFun : ℝ → E → ℝ
  mem_Icc : ∀ (R : ℝ) (x : E), to_fun R x ∈ Icc (0 : ℝ) 1
  Symmetric : ∀ (R : ℝ) (x : E), to_fun R (-x) = to_fun R x
  smooth : ContDiffOn ℝ ⊤ (uncurry to_fun) (Ioi (1 : ℝ) ×ˢ (univ : Set E))
  eq_one : ∀ (R : ℝ) (hR : 1 < R) (x : E) (hx : ‖x‖ ≤ 1), to_fun R x = 1
  support : ∀ (R : ℝ) (hR : 1 < R), support (to_fun R) = Metric.ball (0 : E) R
#align cont_diff_bump_base ContDiffBumpBase

/-- A class registering that a real vector space admits bump functions. This will be instantiated
first for inner product spaces, and then for finite-dimensional normed spaces.
We use a specific class instead of `nonempty (cont_diff_bump_base E)` for performance reasons. -/
class HasContDiffBump (E : Type _) [NormedAddCommGroup E] [NormedSpace ℝ E] : Prop where
  out : Nonempty (ContDiffBumpBase E)
#align has_cont_diff_bump HasContDiffBump

/-- In a space with `C^∞` bump functions, register some function that will be used as a basis
to construct bump functions of arbitrary size around any point. -/
def someContDiffBumpBase (E : Type _) [NormedAddCommGroup E] [NormedSpace ℝ E]
    [hb : HasContDiffBump E] : ContDiffBumpBase E :=
  Nonempty.some hb.out
#align some_cont_diff_bump_base someContDiffBumpBase

/-- Any inner product space has smooth bump functions. -/
instance (priority := 100) hasContDiffBump_of_innerProductSpace (E : Type _) [NormedAddCommGroup E]
    [InnerProductSpace ℝ E] : HasContDiffBump E :=
  let e : ContDiffBumpBase E :=
    { toFun := fun R x => Real.smoothTransition ((R - ‖x‖) / (R - 1))
      mem_Icc := fun R x => ⟨Real.smoothTransition.nonneg _, Real.smoothTransition.le_one _⟩
      Symmetric := fun R x => by simp only [norm_neg]
      smooth := by
        rintro ⟨R, x⟩ ⟨hR : 1 < R, hx⟩
        apply ContDiffAt.contDiffWithinAt
        rcases eq_or_ne x 0 with (rfl | hx)
        · have :
            (fun p : ℝ × E => Real.smoothTransition ((p.1 - ‖p.2‖) / (p.1 - 1))) =ᶠ[𝓝 (R, 0)]
              fun p => 1 :=
            by
            have A :
              tendsto (fun p : ℝ × E => (p.1 - ‖p.2‖) / (p.1 - 1)) (𝓝 (R, 0))
                (𝓝 ((R - ‖(0 : E)‖) / (R - 1))) :=
              by
              rw [nhds_prod_eq]
              apply (tendsto_fst.sub tendsto_snd.norm).div (tendsto_fst.sub tendsto_const_nhds)
              exact (sub_pos.2 hR).ne'
            have : ∀ᶠ p : ℝ × E in 𝓝 (R, 0), 1 < (p.1 - ‖p.2‖) / (p.1 - 1) :=
              by
              apply (tendsto_order.1 A).1
              apply (one_lt_div (sub_pos.2 hR)).2
              simp only [norm_zero, tsub_zero, sub_lt_self_iff, zero_lt_one]
            filter_upwards [this]with q hq
            exact Real.smoothTransition.one_of_one_le hq.le
          exact cont_diff_at_const.congr_of_eventually_eq this
        · refine' real.smooth_transition.cont_diff_at.comp _ _
          refine' ContDiffAt.div _ _ (sub_pos.2 hR).ne'
          · exact cont_diff_at_fst.sub (cont_diff_at_snd.norm ℝ hx)
          · exact cont_diff_at_fst.sub contDiffAt_const
      eq_one := fun R hR x hx =>
        Real.smoothTransition.one_of_one_le <| (one_le_div (sub_pos.2 hR)).2 (sub_le_sub_left hx _)
      support := fun R hR => by
        apply subset.antisymm
        · intro x hx
          simp only [mem_support] at hx
          contrapose! hx
          simp only [mem_ball_zero_iff, not_lt] at hx
          apply Real.smoothTransition.zero_of_nonpos
          apply div_nonpos_of_nonpos_of_nonneg <;> linarith
        · intro x hx
          simp only [mem_ball_zero_iff] at hx
          apply (Real.smoothTransition.pos_of_pos _).ne'
          apply div_pos <;> linarith }
  ⟨⟨e⟩⟩
#align has_cont_diff_bump_of_inner_product_space hasContDiffBump_of_innerProductSpace

namespace ContDiffBump

/- warning: cont_diff_bump.R_pos clashes with cont_diff_bump.r_pos -> ContDiffBump.r_pos
Case conversion may be inaccurate. Consider using '#align cont_diff_bump.R_pos ContDiffBump.r_posₓ'. -/
#print ContDiffBump.r_pos /-
theorem r_pos {c : E} (f : ContDiffBump c) : 0 < f.r :=
  f.r_pos.trans f.r_lt_r
#align cont_diff_bump.R_pos ContDiffBump.r_pos
-/

theorem one_lt_r_div_r {c : E} (f : ContDiffBump c) : 1 < f.r / f.R :=
  by
  rw [one_lt_div f.r_pos]
  exact f.r_lt_R
#align cont_diff_bump.one_lt_R_div_r ContDiffBump.one_lt_r_div_r

instance (c : E) : Inhabited (ContDiffBump c) :=
  ⟨⟨1, 2, zero_lt_one, one_lt_two⟩⟩

variable [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup X] [NormedSpace ℝ X]
  [HasContDiffBump E] {c : E} (f : ContDiffBump c) {x : E} {n : ℕ∞}

/-- The function defined by `f : cont_diff_bump c`. Use automatic coercion to
function instead. -/
def toFun {c : E} (f : ContDiffBump c) : E → ℝ := fun x =>
  (someContDiffBumpBase E).toFun (f.r / f.R) (f.R⁻¹ • (x - c))
#align cont_diff_bump.to_fun ContDiffBump.toFun

instance : CoeFun (ContDiffBump c) fun _ => E → ℝ :=
  ⟨toFun⟩

protected theorem def (x : E) :
    f x = (someContDiffBumpBase E).toFun (f.r / f.R) (f.R⁻¹ • (x - c)) :=
  rfl
#align cont_diff_bump.def ContDiffBump.def

protected theorem sub (x : E) : f (c - x) = f (c + x) := by simp [f.def, ContDiffBumpBase.symmetric]
#align cont_diff_bump.sub ContDiffBump.sub

protected theorem neg (f : ContDiffBump (0 : E)) (x : E) : f (-x) = f x := by
  simp_rw [← zero_sub, f.sub, zero_add]
#align cont_diff_bump.neg ContDiffBump.neg

open Metric

theorem one_of_mem_closedBall (hx : x ∈ closedBall c f.R) : f x = 1 :=
  by
  apply ContDiffBumpBase.eq_one _ _ f.one_lt_R_div_r
  simpa only [norm_smul, norm_eq_abs, abs_inv, abs_of_nonneg f.r_pos.le, ← div_eq_inv_mul,
    div_le_one f.r_pos] using mem_closedBall_iff_norm.1 hx
#align cont_diff_bump.one_of_mem_closed_ball ContDiffBump.one_of_mem_closedBall

theorem nonneg : 0 ≤ f x :=
  (ContDiffBumpBase.mem_Icc (someContDiffBumpBase E) _ _).1
#align cont_diff_bump.nonneg ContDiffBump.nonneg

/-- A version of `cont_diff_bump.nonneg` with `x` explicit -/
theorem nonneg' (x : E) : 0 ≤ f x :=
  f.NonNeg
#align cont_diff_bump.nonneg' ContDiffBump.nonneg'

theorem le_one : f x ≤ 1 :=
  (ContDiffBumpBase.mem_Icc (someContDiffBumpBase E) _ _).2
#align cont_diff_bump.le_one ContDiffBump.le_one

theorem pos_of_mem_ball (hx : x ∈ ball c f.r) : 0 < f x :=
  by
  refine' lt_iff_le_and_ne.2 ⟨f.nonneg, Ne.symm _⟩
  change f.r⁻¹ • (x - c) ∈ support ((someContDiffBumpBase E).toFun (f.R / f.r))
  rw [ContDiffBumpBase.support _ _ f.one_lt_R_div_r]
  simp only [dist_eq_norm, mem_ball] at hx
  simpa only [norm_smul, mem_ball_zero_iff, norm_eq_abs, abs_inv, abs_of_nonneg f.r_pos.le, ←
    div_eq_inv_mul] using (div_lt_div_right f.r_pos).2 hx
#align cont_diff_bump.pos_of_mem_ball ContDiffBump.pos_of_mem_ball

theorem zero_of_le_dist (hx : f.r ≤ dist x c) : f x = 0 :=
  by
  rw [dist_eq_norm] at hx
  suffices H : f.r⁻¹ • (x - c) ∉ support ((someContDiffBumpBase E).toFun (f.R / f.r))
  · simpa only [mem_support, Classical.not_not] using H
  rw [ContDiffBumpBase.support _ _ f.one_lt_R_div_r]
  simp [norm_smul, norm_eq_abs, abs_inv, abs_of_nonneg f.r_pos.le, ← div_eq_inv_mul]
  exact div_le_div_of_le f.r_pos.le hx
#align cont_diff_bump.zero_of_le_dist ContDiffBump.zero_of_le_dist

theorem support_eq : support (f : E → ℝ) = Metric.ball c f.r :=
  by
  ext x
  suffices f x ≠ 0 ↔ dist x c < f.R by simpa [mem_support]
  cases' lt_or_le (dist x c) f.R with hx hx
  · simp only [hx, (f.pos_of_mem_ball hx).ne', Ne.def, not_false_iff]
  · simp only [hx.not_lt, f.zero_of_le_dist hx, Ne.def, eq_self_iff_true, not_true]
#align cont_diff_bump.support_eq ContDiffBump.support_eq

theorem tsupport_eq : tsupport f = closedBall c f.r := by
  simp_rw [tsupport, f.support_eq, closure_ball _ f.R_pos.ne']
#align cont_diff_bump.tsupport_eq ContDiffBump.tsupport_eq

protected theorem hasCompactSupport [FiniteDimensional ℝ E] : HasCompactSupport f := by
  simp_rw [HasCompactSupport, f.tsupport_eq, is_compact_closed_ball]
#align cont_diff_bump.has_compact_support ContDiffBump.hasCompactSupport

theorem eventuallyEq_one_of_mem_ball (h : x ∈ ball c f.R) : f =ᶠ[𝓝 x] 1 :=
  ((isOpen_lt (continuous_id.dist continuous_const) continuous_const).eventually_mem h).mono
    fun z hz => f.one_of_mem_closedBall (le_of_lt hz)
#align cont_diff_bump.eventually_eq_one_of_mem_ball ContDiffBump.eventuallyEq_one_of_mem_ball

theorem eventuallyEq_one : f =ᶠ[𝓝 c] 1 :=
  f.eventuallyEq_one_of_mem_ball (mem_ball_self f.r_pos)
#align cont_diff_bump.eventually_eq_one ContDiffBump.eventuallyEq_one

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- `cont_diff_bump` is `𝒞ⁿ` in all its arguments. -/
protected theorem ContDiffAt.contDiffBump {c g : X → E} {f : ∀ x, ContDiffBump (c x)} {x : X}
    (hc : ContDiffAt ℝ n c x) (hr : ContDiffAt ℝ n (fun x => (f x).R) x)
    (hR : ContDiffAt ℝ n (fun x => (f x).r) x) (hg : ContDiffAt ℝ n g x) :
    ContDiffAt ℝ n (fun x => f x (g x)) x :=
  by
  rcases eq_or_ne (g x) (c x) with (hx | hx)
  · have : (fun x => f x (g x)) =ᶠ[𝓝 x] fun x => 1 :=
      by
      have : dist (g x) (c x) < (f x).R := by simp_rw [hx, dist_self, (f x).r_pos]
      have :=
        ContinuousAt.eventually_lt (hg.continuous_at.dist hc.continuous_at) hr.continuous_at this
      exact eventually_of_mem this fun x hx => (f x).one_of_mem_closedBall (mem_set_of_eq.mp hx).le
    exact cont_diff_at_const.congr_of_eventually_eq this
  · change
      ContDiffAt ℝ n
        (uncurry (someContDiffBumpBase E).toFun ∘ fun x : X =>
          ((f x).r / (f x).R, (f x).R⁻¹ • (g x - c x)))
        x
    have A : ((f x).r / (f x).R, (f x).R⁻¹ • (g x - c x)) ∈ Ioi (1 : ℝ) ×ˢ (univ : Set E) := by
      simpa only [prod_mk_mem_set_prod_eq, mem_univ, and_true_iff] using (f x).one_lt_r_div_r
    have B : Ioi (1 : ℝ) ×ˢ (univ : Set E) ∈ 𝓝 ((f x).r / (f x).R, (f x).R⁻¹ • (g x - c x)) :=
      (is_open_Ioi.prod isOpen_univ).mem_nhds A
    apply
      ((((someContDiffBumpBase E).smooth.ContDiffWithinAt A).ContDiffAt B).of_le le_top).comp x _
    exact (hR.div hr (f x).r_pos.ne').Prod ((hr.inv (f x).r_pos.ne').smul (hg.sub hc))
#align cont_diff_at.cont_diff_bump ContDiffAt.contDiffBump

theorem ContDiff.contDiffBump {c g : X → E} {f : ∀ x, ContDiffBump (c x)} (hc : ContDiff ℝ n c)
    (hr : ContDiff ℝ n fun x => (f x).R) (hR : ContDiff ℝ n fun x => (f x).r)
    (hg : ContDiff ℝ n g) : ContDiff ℝ n fun x => f x (g x) :=
  by
  rw [contDiff_iff_contDiffAt] at *
  exact fun x => (hc x).ContDiffBump (hr x) (hR x) (hg x)
#align cont_diff.cont_diff_bump ContDiff.contDiffBump

protected theorem contDiff : ContDiff ℝ n f :=
  contDiff_const.ContDiffBump contDiff_const contDiff_const contDiff_id
#align cont_diff_bump.cont_diff ContDiffBump.contDiff

protected theorem contDiffAt : ContDiffAt ℝ n f x :=
  f.ContDiff.ContDiffAt
#align cont_diff_bump.cont_diff_at ContDiffBump.contDiffAt

protected theorem contDiffWithinAt {s : Set E} : ContDiffWithinAt ℝ n f s x :=
  f.ContDiffAt.ContDiffWithinAt
#align cont_diff_bump.cont_diff_within_at ContDiffBump.contDiffWithinAt

protected theorem continuous : Continuous f :=
  contDiff_zero.mp f.ContDiff
#align cont_diff_bump.continuous ContDiffBump.continuous

open MeasureTheory

variable [MeasurableSpace E] {μ : Measure E}

/-- A bump function normed so that `∫ x, f.normed μ x ∂μ = 1`. -/
protected def normed (μ : Measure E) : E → ℝ := fun x => f x / ∫ x, f x ∂μ
#align cont_diff_bump.normed ContDiffBump.normed

theorem normed_def {μ : Measure E} (x : E) : f.normed μ x = f x / ∫ x, f x ∂μ :=
  rfl
#align cont_diff_bump.normed_def ContDiffBump.normed_def

theorem nonneg_normed (x : E) : 0 ≤ f.normed μ x :=
  div_nonneg f.NonNeg <| integral_nonneg f.nonneg'
#align cont_diff_bump.nonneg_normed ContDiffBump.nonneg_normed

theorem contDiff_normed {n : ℕ∞} : ContDiff ℝ n (f.normed μ) :=
  f.ContDiff.div_const _
#align cont_diff_bump.cont_diff_normed ContDiffBump.contDiff_normed

theorem continuous_normed : Continuous (f.normed μ) :=
  f.Continuous.div_const _
#align cont_diff_bump.continuous_normed ContDiffBump.continuous_normed

theorem normed_sub (x : E) : f.normed μ (c - x) = f.normed μ (c + x) := by
  simp_rw [f.normed_def, f.sub]
#align cont_diff_bump.normed_sub ContDiffBump.normed_sub

theorem normed_neg (f : ContDiffBump (0 : E)) (x : E) : f.normed μ (-x) = f.normed μ x := by
  simp_rw [f.normed_def, f.neg]
#align cont_diff_bump.normed_neg ContDiffBump.normed_neg

variable [BorelSpace E] [FiniteDimensional ℝ E] [IsLocallyFiniteMeasure μ]

protected theorem integrable : Integrable f μ :=
  f.Continuous.integrableOfHasCompactSupport f.HasCompactSupport
#align cont_diff_bump.integrable ContDiffBump.integrable

protected theorem integrableNormed : Integrable (f.normed μ) μ :=
  f.Integrable.div_const _
#align cont_diff_bump.integrable_normed ContDiffBump.integrableNormed

variable [μ.IsOpenPosMeasure]

theorem integral_pos : 0 < ∫ x, f x ∂μ :=
  by
  refine' (integral_pos_iff_support_of_nonneg f.nonneg' f.integrable).mpr _
  rw [f.support_eq]
  refine' is_open_ball.measure_pos _ (nonempty_ball.mpr f.R_pos)
#align cont_diff_bump.integral_pos ContDiffBump.integral_pos

theorem integral_normed : (∫ x, f.normed μ x ∂μ) = 1 :=
  by
  simp_rw [ContDiffBump.normed, div_eq_mul_inv, mul_comm (f _), ← smul_eq_mul, integral_smul]
  exact inv_mul_cancel f.integral_pos.ne'
#align cont_diff_bump.integral_normed ContDiffBump.integral_normed

theorem support_normed_eq : support (f.normed μ) = Metric.ball c f.r := by
  simp_rw [ContDiffBump.normed, support_div, f.support_eq, support_const f.integral_pos.ne',
    inter_univ]
#align cont_diff_bump.support_normed_eq ContDiffBump.support_normed_eq

theorem tsupport_normed_eq : tsupport (f.normed μ) = Metric.closedBall c f.r := by
  simp_rw [tsupport, f.support_normed_eq, closure_ball _ f.R_pos.ne']
#align cont_diff_bump.tsupport_normed_eq ContDiffBump.tsupport_normed_eq

theorem hasCompactSupport_normed : HasCompactSupport (f.normed μ) := by
  simp_rw [HasCompactSupport, f.tsupport_normed_eq, is_compact_closed_ball]
#align cont_diff_bump.has_compact_support_normed ContDiffBump.hasCompactSupport_normed

theorem tendsto_support_normed_smallSets {ι} {φ : ι → ContDiffBump c} {l : Filter ι}
    (hφ : Tendsto (fun i => (φ i).r) l (𝓝 0)) :
    Tendsto (fun i => support fun x => (φ i).normed μ x) l (𝓝 c).smallSets :=
  by
  simp_rw [NormedAddCommGroup.tendsto_nhds_zero, Real.norm_eq_abs,
    abs_eq_self.mpr (φ _).r_pos.le] at hφ
  rw [tendsto_small_sets_iff]
  intro t ht
  rcases metric.mem_nhds_iff.mp ht with ⟨ε, hε, ht⟩
  refine' (hφ ε hε).mono fun i hi => subset_trans _ ht
  simp_rw [(φ i).support_normed_eq]
  exact ball_subset_ball hi.le
#align cont_diff_bump.tendsto_support_normed_small_sets ContDiffBump.tendsto_support_normed_smallSets

variable (μ)

theorem integral_normed_smul [CompleteSpace X] (z : X) : (∫ x, f.normed μ x • z ∂μ) = z := by
  simp_rw [integral_smul_const, f.integral_normed, one_smul]
#align cont_diff_bump.integral_normed_smul ContDiffBump.integral_normed_smul

end ContDiffBump