/-
Copyright (c) 2020 Kyle Miller All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kyle Miller.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.linarith.default
import Mathlib.data.sym
import Mathlib.PostPort

universes u u_1 u_2 u_3

namespace Mathlib

/-!
# The symmetric square

This file defines the symmetric square, which is `α × α` modulo
swapping.  This is also known as the type of unordered pairs.

More generally, the symmetric square is the second symmetric power
(see `data.sym`). The equivalence is `sym2.equiv_sym`.

From the point of view that an unordered pair is equivalent to a
multiset of cardinality two (see `sym2.equiv_multiset`), there is a
`has_mem` instance `sym2.mem`, which is a `Prop`-valued membership
test.  Given `h : a ∈ z` for `z : sym2 α`, then `h.other` is the other
element of the pair, defined using `classical.choice`.  If `α` has
decidable equality, then `h.other'` computably gives the other element.

Recall that an undirected graph (allowing self loops, but no multiple
edges) is equivalent to a symmetric relation on the vertex type `α`.
Given a symmetric relation on `α`, the corresponding edge set is
constructed by `sym2.from_rel`.

## Notation

The symmetric square has a setoid instance, so `⟦(a, b)⟧` denotes a
term of the symmetric square.

## Tags

symmetric square, unordered pairs, symmetric powers
-/

namespace sym2

/--
This is the relation capturing the notion of pairs equivalent up to permutations.
-/
inductive rel (α : Type u) : α × α → α × α → Prop where
| refl : ∀ (x y : α), rel α (x, y) (x, y)
| swap : ∀ (x y : α), rel α (x, y) (y, x)

theorem rel.symm {α : Type u} {x : α × α} {y : α × α} : rel α x y → rel α y x := sorry

theorem rel.trans {α : Type u} {x : α × α} {y : α × α} {z : α × α} :
    rel α x y → rel α y z → rel α x z :=
  sorry

theorem rel.is_equivalence {α : Type u} : equivalence (rel α) := sorry

protected instance rel.setoid (α : Type u) : setoid (α × α) := setoid.mk (rel α) rel.is_equivalence

end sym2

/--
`sym2 α` is the symmetric square of `α`, which, in other words, is the
type of unordered pairs.

It is equivalent in a natural way to multisets of cardinality 2 (see
`sym2.equiv_multiset`).
-/
def sym2 (α : Type u) := quotient sorry

namespace sym2

theorem eq_swap {α : Type u} {a : α} {b : α} : quotient.mk (a, b) = quotient.mk (b, a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (quotient.mk (a, b) = quotient.mk (b, a))) (propext quotient.eq)))
    (rel.swap a b)

theorem congr_right {α : Type u} {a : α} {b : α} {c : α} :
    quotient.mk (a, b) = quotient.mk (a, c) ↔ b = c :=
  sorry

theorem congr_left {α : Type u} {a : α} {b : α} {c : α} :
    quotient.mk (b, a) = quotient.mk (c, a) ↔ b = c :=
  sorry

/--
The functor `sym2` is functorial, and this function constructs the induced maps.
-/
def map {α : Type u_1} {β : Type u_2} (f : α → β) : sym2 α → sym2 β :=
  quotient.map (prod.map f f) sorry

@[simp] theorem map_id {α : Type u} : map id = id := sorry

theorem map_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} {g : β → γ} {f : α → β} :
    map (g ∘ f) = map g ∘ map f :=
  sorry

@[simp] theorem map_pair_eq {α : Type u_1} {β : Type u_2} (f : α → β) (x : α) (y : α) :
    map f (quotient.mk (x, y)) = quotient.mk (f x, f y) :=
  sorry

/-! ### Declarations about membership -/

/--
This is a predicate that determines whether a given term is a member of a term of the
symmetric square.  From this point of view, the symmetric square is the subtype of
cardinality-two multisets on `α`.
-/
def mem {α : Type u} (x : α) (z : sym2 α) := ∃ (y : α), z = quotient.mk (x, y)

protected instance has_mem {α : Type u} : has_mem α (sym2 α) := has_mem.mk mem

theorem mk_has_mem {α : Type u} (x : α) (y : α) : x ∈ quotient.mk (x, y) := Exists.intro y rfl

theorem mk_has_mem_right {α : Type u} (x : α) (y : α) : y ∈ quotient.mk (x, y) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (y ∈ quotient.mk (x, y))) eq_swap)) (mk_has_mem y x)

/--
Given an element of the unordered pair, give the other element using `classical.some`.
See also `mem.other'` for the computable version.
-/
def mem.other {α : Type u} {a : α} {z : sym2 α} (h : a ∈ z) : α := classical.some h

@[simp] theorem mem_other_spec {α : Type u} {a : α} {z : sym2 α} (h : a ∈ z) :
    quotient.mk (a, mem.other h) = z :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (quotient.mk (a, mem.other h) = z)) (Eq.symm (classical.some_spec h))))
    (Eq.refl z)

theorem eq_iff {α : Type u} {x : α} {y : α} {z : α} {w : α} :
    quotient.mk (x, y) = quotient.mk (z, w) ↔ x = z ∧ y = w ∨ x = w ∧ y = z :=
  sorry

@[simp] theorem mem_iff {α : Type u} {a : α} {b : α} {c : α} :
    a ∈ quotient.mk (b, c) ↔ a = b ∨ a = c :=
  sorry

theorem mem_other_mem {α : Type u} {a : α} {z : sym2 α} (h : a ∈ z) : mem.other h ∈ z := sorry

theorem elems_iff_eq {α : Type u} {x : α} {y : α} {z : sym2 α} (hne : x ≠ y) :
    x ∈ z ∧ y ∈ z ↔ z = quotient.mk (x, y) :=
  sorry

theorem sym2_ext {α : Type u} (z : sym2 α) (z' : sym2 α) (h : ∀ (x : α), x ∈ z ↔ x ∈ z') : z = z' :=
  sorry

protected instance mem.decidable {α : Type u} [DecidableEq α] (x : α) (z : sym2 α) :
    Decidable (x ∈ z) :=
  quotient.rec_on_subsingleton z fun (_x : α × α) => sorry

/--
A type `α` is naturally included in the diagonal of `α × α`, and this function gives the image
of this diagonal in `sym2 α`.
-/
def diag {α : Type u} (x : α) : sym2 α := quotient.mk (x, x)

/--
A predicate for testing whether an element of `sym2 α` is on the diagonal.
-/
def is_diag {α : Type u} (z : sym2 α) := z ∈ set.range diag

@[simp] theorem diag_is_diag {α : Type u} (a : α) : is_diag (diag a) :=
  Exists.intro a (id (Eq.refl (diag a)))

@[simp] theorem is_diag_iff_proj_eq {α : Type u} (z : α × α) :
    is_diag (quotient.mk z) ↔ prod.fst z = prod.snd z :=
  sorry

protected instance is_diag.decidable_pred (α : Type u) [DecidableEq α] : decidable_pred is_diag :=
  fun (z : sym2 α) =>
    quotient.rec_on_subsingleton z
      fun (a : α × α) => eq.mpr sorry (_inst_1 (prod.fst a) (prod.snd a))

theorem mem_other_ne {α : Type u} {a : α} {z : sym2 α} (hd : ¬is_diag z) (h : a ∈ z) :
    mem.other h ≠ a :=
  sorry

/-! ### Declarations about symmetric relations -/

/--
Symmetric relations define a set on `sym2 α` by taking all those pairs
of elements that are related.
-/
def from_rel {α : Type u} {r : α → α → Prop} (sym : symmetric r) : set (sym2 α) :=
  quotient.lift (function.uncurry r) sorry

@[simp] theorem from_rel_proj_prop {α : Type u} {r : α → α → Prop} {sym : symmetric r} {z : α × α} :
    quotient.mk z ∈ from_rel sym ↔ r (prod.fst z) (prod.snd z) :=
  iff.rfl

@[simp] theorem from_rel_prop {α : Type u} {r : α → α → Prop} {sym : symmetric r} {a : α} {b : α} :
    quotient.mk (a, b) ∈ from_rel sym ↔ r a b :=
  sorry

theorem from_rel_irreflexive {α : Type u} {r : α → α → Prop} {sym : symmetric r} :
    irreflexive r ↔ ∀ {z : sym2 α}, z ∈ from_rel sym → ¬is_diag z :=
  sorry

theorem mem_from_rel_irrefl_other_ne {α : Type u} {r : α → α → Prop} {sym : symmetric r}
    (irrefl : irreflexive r) {a : α} {z : sym2 α} (hz : z ∈ from_rel sym) (h : a ∈ z) :
    mem.other h ≠ a :=
  mem_other_ne (iff.mp from_rel_irreflexive irrefl z hz) h

protected instance from_rel.decidable_pred {α : Type u} {r : α → α → Prop} (sym : symmetric r)
    [h : DecidableRel r] : decidable_pred (from_rel sym) :=
  fun (z : sym2 α) => quotient.rec_on_subsingleton z fun (x : α × α) => h (prod.fst x) (prod.snd x)

/-! ### Equivalence to the second symmetric power -/

/--
The symmetric square is equivalent to length-2 vectors up to permutations.
-/
def sym2_equiv_sym' {α : Type u_1} : sym2 α ≃ sym.sym' α (bit0 1) :=
  equiv.mk
    (quotient.map (fun (x : α × α) => { val := [prod.fst x, prod.snd x], property := sorry }) sorry)
    (quotient.map from_vector sorry) sorry sorry

/--
The symmetric square is equivalent to the second symmetric power.
-/
def equiv_sym (α : Type u_1) : sym2 α ≃ sym α (bit0 1) :=
  equiv.trans sym2_equiv_sym' (equiv.symm sym.sym_equiv_sym')

/--
The symmetric square is equivalent to multisets of cardinality
two. (This is currently a synonym for `equiv_sym`, but it's provided
in case the definition for `sym` changes.)
-/
def equiv_multiset (α : Type u_1) :
    sym2 α ≃ Subtype fun (s : multiset α) => coe_fn multiset.card s = bit0 1 :=
  equiv_sym α

/--
An algorithm for computing `sym2.rel`.
-/
def rel_bool {α : Type u} [DecidableEq α] (x : α × α) (y : α × α) : Bool :=
  ite (prod.fst x = prod.fst y) (to_bool (prod.snd x = prod.snd y))
    (ite (prod.fst x = prod.snd y) (to_bool (prod.snd x = prod.fst y)) false)

theorem rel_bool_spec {α : Type u} [DecidableEq α] (x : α × α) (y : α × α) :
    ↥(rel_bool x y) ↔ rel α x y :=
  sorry

/--
Given `[decidable_eq α]` and `[fintype α]`, the following instance gives `fintype (sym2 α)`.
-/
protected instance rel.decidable_rel (α : Type u_1) [DecidableEq α] : DecidableRel (rel α) :=
  fun (x y : α × α) => decidable_of_bool (rel_bool x y) sorry

/--
A function that gives the other element of a pair given one of the elements.  Used in `mem.other'`.
-/
/--
Get the other element of the unordered pair using the decidable equality.
This is the computable version of `mem.other`.
-/
def mem.other' {α : Type u} [DecidableEq α] {a : α} {z : sym2 α} (h : a ∈ z) : α :=
  quot.rec (fun (x : α × α) (h' : a ∈ Quot.mk setoid.r x) => pair_other a x) sorry z h

@[simp] theorem mem_other_spec' {α : Type u} [DecidableEq α] {a : α} {z : sym2 α} (h : a ∈ z) :
    quotient.mk (a, mem.other' h) = z :=
  sorry

@[simp] theorem other_eq_other' {α : Type u} [DecidableEq α] {a : α} {z : sym2 α} (h : a ∈ z) :
    mem.other h = mem.other' h :=
  eq.mpr (id (Eq._oldrec (Eq.refl (mem.other h = mem.other' h)) (Eq.symm (propext congr_right))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (quotient.mk (a, mem.other h) = quotient.mk (a, mem.other' h)))
          (mem_other_spec' h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (quotient.mk (a, mem.other h) = z)) (mem_other_spec h)))
        (Eq.refl z)))

theorem mem_other_mem' {α : Type u} [DecidableEq α] {a : α} {z : sym2 α} (h : a ∈ z) :
    mem.other' h ∈ z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (mem.other' h ∈ z)) (Eq.symm (other_eq_other' h))))
    (mem_other_mem h)

theorem other_invol' {α : Type u} [DecidableEq α] {a : α} {z : sym2 α} (ha : a ∈ z)
    (hb : mem.other' ha ∈ z) : mem.other' hb = a :=
  sorry

theorem other_invol {α : Type u} {a : α} {z : sym2 α} (ha : a ∈ z) (hb : mem.other ha ∈ z) :
    mem.other hb = a :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Yuma Mizuno. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuma Mizuno
-/
import category_theory.discrete_category
import category_theory.bicategory.functor
import category_theory.bicategory.strict

/-!
# Locally discrete bicategories

A category `C` can be promoted to a strict bicategory `locally_discrete C`. The objects and the
1-morphisms in `locally_discrete C` are the same as the objects and the morphisms, respectively,
in `C`, and the 2-morphisms in `locally_discrete C` are the equalities between 1-morphisms. In
other words, the category consisting of the 1-morphisms between each pair of objects `X` and `Y`
in `locally_discrete C` is defined as the discrete category associated with the type `X ⟶ Y`.
-/

namespace category_theory

open bicategory discrete
open_locale bicategory

universes w₂ v v₁ v₂ u u₁ u₂

variables {C : Type u}

/--
A type synonym for promoting any type to a category,
with the only morphisms being equalities.
-/
def locally_discrete (C : Type u) := C

namespace locally_discrete

instance : Π [inhabited C], inhabited (locally_discrete C) := id

instance [category_struct.{v} C] : category_struct (locally_discrete C) :=
{ hom := λ (X Y : C), discrete (X ⟶ Y),
  id := λ X : C, ⟨𝟙 X⟩,
  comp := λ X Y Z f g, ⟨f.as ≫ g.as⟩ }

variables {C} [category_struct.{v} C]

@[priority 900]
instance hom_small_category (X Y : locally_discrete C) : small_category (X ⟶ Y) :=
category_theory.discrete_category (X ⟶ Y)

/-- Extract the equation from a 2-morphism in a locally discrete 2-category. -/
lemma eq_of_hom {X Y : locally_discrete C} {f g : X ⟶ Y} (η : f ⟶ g) : f = g :=
begin
  have : discrete.mk (f.as) = discrete.mk (g.as) := congr_arg discrete.mk (eq_of_hom η),
  simpa using this
end

end locally_discrete

variables (C) [category.{v} C]

/--
The locally discrete bicategory on a category is a bicategory in which the objects and the
1-morphisms are the same as those in the underlying category, and the 2-morphisms are the
equalities between 1-morphisms.
-/
instance locally_discrete_bicategory : bicategory (locally_discrete C) :=
{ whisker_left  := λ X Y Z f g h η, eq_to_hom (congr_arg2 (≫) rfl (locally_discrete.eq_of_hom η)),
  whisker_right := λ X Y Z f g η h, eq_to_hom (congr_arg2 (≫) (locally_discrete.eq_of_hom η) rfl),
  associator := λ W X Y Z f g h, eq_to_iso $ by { unfold_projs, simp only [category.assoc] },
  left_unitor  := λ X Y f, eq_to_iso $ by { unfold_projs, simp only [category.id_comp, mk_as] },
  right_unitor := λ X Y f, eq_to_iso $ by { unfold_projs, simp only [category.comp_id, mk_as] } }

/-- A locally discrete bicategory is strict. -/
instance locally_discrete_bicategory.strict : strict (locally_discrete C) :=
{ id_comp' := by { intros, ext1, unfold_projs, apply category.id_comp },
  comp_id' := by { intros, ext1, unfold_projs, apply category.comp_id },
  assoc' := by { intros, ext1, unfold_projs, apply category.assoc } }

variables {I : Type u₁} [category.{v₁} I] {B : Type u₂} [bicategory.{w₂ v₂} B] [strict B]

/--
If `B` is a strict bicategory and `I` is a (1-)category, any functor (of 1-categories) `I ⥤ B` can
be promoted to an oplax functor from `locally_discrete I` to `B`.
-/
@[simps]
def functor.to_oplax_functor (F : I ⥤ B) : oplax_functor (locally_discrete I) B :=
{ obj := F.obj,
  map := λ X Y f, F.map f.as,
  map₂ := λ i j f g η, eq_to_hom (congr_arg _ (eq_of_hom η)),
  map_id := λ i, eq_to_hom (F.map_id i),
  map_comp := λ i j k f g, eq_to_hom (F.map_comp f.as g.as) }

end category_theory


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.opposite
import Mathlib.algebra.field
import Mathlib.group_theory.group_action.defs
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

universes u u_1 u_2

namespace Mathlib

/-!
# Algebraic operations on `αᵒᵖ`
-/

namespace opposite

protected instance has_add (α : Type u) [Add α] : Add (αᵒᵖ) :=
  { add := fun (x y : αᵒᵖ) => op (unop x + unop y) }

protected instance has_sub (α : Type u) [Sub α] : Sub (αᵒᵖ) :=
  { sub := fun (x y : αᵒᵖ) => op (unop x - unop y) }

protected instance add_semigroup (α : Type u) [add_semigroup α] : add_semigroup (αᵒᵖ) :=
  add_semigroup.mk Add.add sorry

protected instance add_left_cancel_semigroup (α : Type u) [add_left_cancel_semigroup α] :
    add_left_cancel_semigroup (αᵒᵖ) :=
  add_left_cancel_semigroup.mk add_semigroup.add sorry sorry

protected instance add_right_cancel_semigroup (α : Type u) [add_right_cancel_semigroup α] :
    add_right_cancel_semigroup (αᵒᵖ) :=
  add_right_cancel_semigroup.mk add_semigroup.add sorry sorry

protected instance add_comm_semigroup (α : Type u) [add_comm_semigroup α] :
    add_comm_semigroup (αᵒᵖ) :=
  add_comm_semigroup.mk add_semigroup.add sorry sorry

protected instance has_zero (α : Type u) [HasZero α] : HasZero (αᵒᵖ) := { zero := op 0 }

protected instance nontrivial (α : Type u) [nontrivial α] : nontrivial (αᵒᵖ) := sorry

@[simp] theorem unop_eq_zero_iff (α : Type u) [HasZero α] (a : αᵒᵖ) : unop a = 0 ↔ a = 0 :=
  iff.refl (unop a = 0)

@[simp] theorem op_eq_zero_iff (α : Type u) [HasZero α] (a : α) : op a = 0 ↔ a = 0 :=
  iff.refl (op a = 0)

protected instance add_monoid (α : Type u) [add_monoid α] : add_monoid (αᵒᵖ) :=
  add_monoid.mk add_semigroup.add sorry 0 sorry sorry

protected instance add_comm_monoid (α : Type u) [add_comm_monoid α] : add_comm_monoid (αᵒᵖ) :=
  add_comm_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry sorry

protected instance has_neg (α : Type u) [Neg α] : Neg (αᵒᵖ) :=
  { neg := fun (x : αᵒᵖ) => op (-unop x) }

protected instance add_group (α : Type u) [add_group α] : add_group (αᵒᵖ) :=
  add_group.mk add_monoid.add sorry add_monoid.zero sorry sorry Neg.neg Sub.sub sorry

protected instance add_comm_group (α : Type u) [add_comm_group α] : add_comm_group (αᵒᵖ) :=
  add_comm_group.mk add_group.add sorry add_group.zero sorry sorry add_group.neg add_group.sub sorry
    sorry

protected instance has_mul (α : Type u) [Mul α] : Mul (αᵒᵖ) :=
  { mul := fun (x y : αᵒᵖ) => op (unop y * unop x) }

protected instance semigroup (α : Type u) [semigroup α] : semigroup (αᵒᵖ) :=
  semigroup.mk Mul.mul sorry

protected instance left_cancel_semigroup (α : Type u) [right_cancel_semigroup α] :
    left_cancel_semigroup (αᵒᵖ) :=
  left_cancel_semigroup.mk semigroup.mul sorry sorry

protected instance right_cancel_semigroup (α : Type u) [left_cancel_semigroup α] :
    right_cancel_semigroup (αᵒᵖ) :=
  right_cancel_semigroup.mk semigroup.mul sorry sorry

protected instance comm_semigroup (α : Type u) [comm_semigroup α] : comm_semigroup (αᵒᵖ) :=
  comm_semigroup.mk semigroup.mul sorry sorry

protected instance has_one (α : Type u) [HasOne α] : HasOne (αᵒᵖ) := { one := op 1 }

@[simp] theorem unop_eq_one_iff (α : Type u) [HasOne α] (a : αᵒᵖ) : unop a = 1 ↔ a = 1 :=
  iff.refl (unop a = 1)

@[simp] theorem op_eq_one_iff (α : Type u) [HasOne α] (a : α) : op a = 1 ↔ a = 1 :=
  iff.refl (op a = 1)

protected instance monoid (α : Type u) [monoid α] : monoid (αᵒᵖ) :=
  monoid.mk semigroup.mul sorry 1 sorry sorry

protected instance comm_monoid (α : Type u) [comm_monoid α] : comm_monoid (αᵒᵖ) :=
  comm_monoid.mk monoid.mul sorry monoid.one sorry sorry sorry

protected instance has_inv (α : Type u) [has_inv α] : has_inv (αᵒᵖ) :=
  has_inv.mk fun (x : αᵒᵖ) => op (unop x⁻¹)

protected instance group (α : Type u) [group α] : group (αᵒᵖ) :=
  group.mk monoid.mul sorry monoid.one sorry sorry has_inv.inv
    (div_inv_monoid.div._default monoid.mul sorry monoid.one sorry sorry has_inv.inv) sorry

protected instance comm_group (α : Type u) [comm_group α] : comm_group (αᵒᵖ) :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

protected instance distrib (α : Type u) [distrib α] : distrib (αᵒᵖ) :=
  distrib.mk Mul.mul Add.add sorry sorry

protected instance semiring (α : Type u) [semiring α] : semiring (αᵒᵖ) :=
  semiring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry monoid.mul sorry
    monoid.one sorry sorry sorry sorry sorry sorry

protected instance ring (α : Type u) [ring α] : ring (αᵒᵖ) :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg
    add_comm_group.sub sorry sorry monoid.mul sorry monoid.one sorry sorry sorry sorry

protected instance comm_ring (α : Type u) [comm_ring α] : comm_ring (αᵒᵖ) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry
    ring.one sorry sorry sorry sorry sorry

protected instance no_zero_divisors (α : Type u) [HasZero α] [Mul α] [no_zero_divisors α] :
    no_zero_divisors (αᵒᵖ) :=
  no_zero_divisors.mk
    fun (x y : αᵒᵖ) (H : op (unop y * unop x) = op 0) =>
      or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero (op_injective H))
        (fun (hy : unop y = 0) => Or.inr (unop_injective hy))
        fun (hx : unop x = 0) => Or.inl (unop_injective hx)

protected instance integral_domain (α : Type u) [integral_domain α] : integral_domain (αᵒᵖ) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub
    sorry sorry comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry sorry sorry sorry

protected instance field (α : Type u) [field α] : field (αᵒᵖ) :=
  field.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry
    comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry sorry has_inv.inv sorry sorry sorry

protected instance has_scalar (α : Type u) (R : Type u_1) [has_scalar R α] : has_scalar R (αᵒᵖ) :=
  has_scalar.mk fun (c : R) (x : αᵒᵖ) => op (c • unop x)

protected instance mul_action (α : Type u) (R : Type u_1) [monoid R] [mul_action R α] :
    mul_action R (αᵒᵖ) :=
  mul_action.mk sorry sorry

protected instance distrib_mul_action (α : Type u) (R : Type u_1) [monoid R] [add_monoid α]
    [distrib_mul_action R α] : distrib_mul_action R (αᵒᵖ) :=
  distrib_mul_action.mk sorry sorry

@[simp] theorem op_zero (α : Type u) [HasZero α] : op 0 = 0 := rfl

@[simp] theorem unop_zero (α : Type u) [HasZero α] : unop 0 = 0 := rfl

@[simp] theorem op_one (α : Type u) [HasOne α] : op 1 = 1 := rfl

@[simp] theorem unop_one (α : Type u) [HasOne α] : unop 1 = 1 := rfl

@[simp] theorem op_add {α : Type u} [Add α] (x : α) (y : α) : op (x + y) = op x + op y := rfl

@[simp] theorem unop_add {α : Type u} [Add α] (x : αᵒᵖ) (y : αᵒᵖ) :
    unop (x + y) = unop x + unop y :=
  rfl

@[simp] theorem op_neg {α : Type u} [Neg α] (x : α) : op (-x) = -op x := rfl

@[simp] theorem unop_neg {α : Type u} [Neg α] (x : αᵒᵖ) : unop (-x) = -unop x := rfl

@[simp] theorem op_mul {α : Type u} [Mul α] (x : α) (y : α) : op (x * y) = op y * op x := rfl

@[simp] theorem unop_mul {α : Type u} [Mul α] (x : αᵒᵖ) (y : αᵒᵖ) :
    unop (x * y) = unop y * unop x :=
  rfl

@[simp] theorem op_inv {α : Type u} [has_inv α] (x : α) : op (x⁻¹) = (op x⁻¹) := rfl

@[simp] theorem unop_inv {α : Type u} [has_inv α] (x : αᵒᵖ) : unop (x⁻¹) = (unop x⁻¹) := rfl

@[simp] theorem op_sub {α : Type u} [add_group α] (x : α) (y : α) : op (x - y) = op x - op y := rfl

@[simp] theorem unop_sub {α : Type u} [add_group α] (x : αᵒᵖ) (y : αᵒᵖ) :
    unop (x - y) = unop x - unop y :=
  rfl

@[simp] theorem op_smul {α : Type u} {R : Type u_1} [has_scalar R α] (c : R) (a : α) :
    op (c • a) = c • op a :=
  rfl

@[simp] theorem unop_smul {α : Type u} {R : Type u_1} [has_scalar R α] (c : R) (a : αᵒᵖ) :
    unop (c • a) = c • unop a :=
  rfl

/-- The function `op` is an additive equivalence. -/
def op_add_equiv {α : Type u} [Add α] : α ≃+ (αᵒᵖ) :=
  add_equiv.mk (equiv.to_fun equiv_to_opposite) (equiv.inv_fun equiv_to_opposite) sorry sorry sorry

@[simp] theorem coe_op_add_equiv {α : Type u} [Add α] : ⇑op_add_equiv = op := rfl

@[simp] theorem coe_op_add_equiv_symm {α : Type u} [Add α] :
    ⇑(add_equiv.symm op_add_equiv) = unop :=
  rfl

@[simp] theorem op_add_equiv_to_equiv {α : Type u} [Add α] :
    add_equiv.to_equiv op_add_equiv = equiv_to_opposite :=
  rfl

end opposite

/-- A ring homomorphism `f : R →+* S` such that `f x` commutes with `f y` for all `x, y` defines
a ring homomorphism to `Sᵒᵖ`. -/
def ring_hom.to_opposite {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R →+* S)
    (hf : ∀ (x y : R), commute (coe_fn f x) (coe_fn f y)) : R →+* (Sᵒᵖ) :=
  ring_hom.mk
    (add_monoid_hom.to_fun
      (add_monoid_hom.comp (add_equiv.to_add_monoid_hom opposite.op_add_equiv) ↑f))
    sorry sorry sorry sorry

@[simp] theorem ring_hom.coe_to_opposite {R : Type u_1} {S : Type u_2} [semiring R] [semiring S]
    (f : R →+* S) (hf : ∀ (x y : R), commute (coe_fn f x) (coe_fn f y)) :
    ⇑(ring_hom.to_opposite f hf) = opposite.op ∘ ⇑f :=
  rfl

end Mathlib


example (x y : ℕ) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  calc
    (x + y) * (x + y)     = (x + y) * x + (x + y) * y       : by rw mul_add
                      ... = x * x + y * x + (x + y) * y     : by rw add_mul
                      ... = x * x + y * x + (x * y + y * y) : by rw add_mul
                      ... = x * x + y * x + x * y + y * y   : by rw ←add_assoc


import analysis.locally_convex.with_seminorms

open topological_space set filter function nnreal

open_locale topological_space nnreal

section any_field

variables {ι 𝕜 E F : Type*} [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]
  [add_comm_group F] [module 𝕜 F] [topological_space F] [topological_add_group F]

lemma seminorm.ball_eq_preimage_ball (p : seminorm 𝕜 E) {r : ℝ} (hr : 0 < r) :
  p.ball 0 r = p ⁻¹' (metric.ball 0 r) :=
begin
  ext x,
  change (_ < _) ↔ (_ < _),
  rw [sub_zero, dist_zero_right, real.norm_of_nonneg (p.nonneg x)]
end

lemma seminorm_family.filter_eq_infi [nonempty ι] (p : seminorm_family 𝕜 E ι) :
  p.module_filter_basis.to_filter_basis.filter = ⨅ i, (𝓝 0).comap (p i) :=
begin
  refine le_antisymm (le_infi $ λ i, _) _,
  { rw p.module_filter_basis.to_filter_basis.has_basis.le_basis_iff (metric.nhds_basis_ball.comap _),
    intros ε hε,
    refine ⟨(p i).ball 0 ε, _, _⟩,
    { convert p.basis_sets_mem {i} hε,
      rw finset.sup_singleton },
    { rw [id, (p i).ball_eq_preimage_ball hε] } },
  { rw p.module_filter_basis.to_filter_basis.has_basis.ge_iff,
    rintros U (hU : U ∈ p.basis_sets),
    rw p.basis_sets_iff at hU,
    rcases hU with ⟨s, r, hr, rfl⟩,
    rw [id, seminorm.ball_finset_sup_eq_Inter _ _ _ hr, s.Inter_mem_sets],
    intros i hi,
    refine mem_infi_of_mem i ⟨metric.ball 0 r, metric.ball_mem_nhds 0 hr, _⟩,
    rw [(p i).ball_eq_preimage_ball hr] }
end

lemma seminorm_family.with_seminorms_iff_nhds_eq_infi [topological_space E]
  [topological_add_group E] [nonempty ι] (p : seminorm_family 𝕜 E ι) :
  with_seminorms p ↔ (𝓝 0 : filter E) = ⨅ i, (𝓝 0).comap (p i) :=
begin
  rw ← p.filter_eq_infi,
  split,
  { intro h,
    rw h.topology_eq_with_seminorms,
    exact add_group_filter_basis.nhds_zero_eq _ },
  { exact p.with_seminorms_of_nhds }
end

def seminorm_family.comp (q : seminorm_family 𝕜 F ι) (f : E →ₗ[𝕜] F) :
  seminorm_family 𝕜 E ι :=
λ i, (q i).comp f

def seminorm_family.comp_apply (q : seminorm_family 𝕜 F ι) (i : ι) (f : E →ₗ[𝕜] F) :
  q.comp f i = (q i).comp f :=
rfl

lemma seminorm.sup_comp (p q : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) :
  (p ⊔ q).comp f = p.comp f ⊔ q.comp f := rfl

lemma seminorm_family.finset_sup_comp (q : seminorm_family 𝕜 F ι) (s : finset ι)
  (f : E →ₗ[𝕜] F) : (s.sup q).comp f = s.sup (q.comp f) :=
begin
  ext x,
  rw [seminorm.comp_apply, seminorm.finset_sup_apply, seminorm.finset_sup_apply],
  refl
end

-- Is it worth keeping ?
lemma seminorm_family.basis_sets_comp (q : seminorm_family 𝕜 F ι) (f : E →ₗ[𝕜] F) :
  (q.comp f).basis_sets = preimage f '' q.basis_sets :=
begin
  rw [seminorm_family.basis_sets, seminorm_family.basis_sets, image_Union₂],
  refine Union_congr (λ s, Union_congr $ λ r, _),
  rw image_Union,
  refine Union_congr (λ hr, _),
  rw [image_singleton, singleton_eq_singleton_iff, ← q.finset_sup_comp,
      seminorm.ball_comp, map_zero],
end

lemma linear_map.with_seminorms_induced [hι : nonempty ι] {q : seminorm_family 𝕜 F ι} [hq : with_seminorms q]
  (f : E →ₗ[𝕜] F) : @with_seminorms 𝕜 E ι _ _ _ _ (q.comp f) (induced f infer_instance) :=
begin
  letI : topological_space E := induced f infer_instance,
  letI : topological_add_group E := topological_add_group_induced f,
  rw [(q.comp f).with_seminorms_iff_nhds_eq_infi, nhds_induced, map_zero,
      q.with_seminorms_iff_nhds_eq_infi.mp hq, comap_infi],
  refine infi_congr (λ i, _),
  exact comap_comap
end

lemma seminorm_family.with_seminorms_congr {ι' : Type*} [nonempty ι] [nonempty ι']
  (p : seminorm_family 𝕜 F ι) {f : ι' → ι} (hf : surjective f) [hp : with_seminorms p] :
  with_seminorms (p ∘ f) :=
begin
  rw seminorm_family.with_seminorms_iff_nhds_eq_infi at ⊢ hp,
  rw [hp, infi, infi, ← hf.range_comp]
end

def seminorm_family.Union {ι' : ι → Type*} (Q : Π i, seminorm_family 𝕜 E (ι' i)) :
  seminorm_family 𝕜 E (Σ i, ι' i) := λ ⟨i, i'⟩, Q i i'

lemma with_seminorms_infi {ι' : ι → Type*} [hι : nonempty ι] [hι' : ∀ i, nonempty (ι' i)]
  {Q : Π i, seminorm_family 𝕜 E (ι' i)}
  {T : ι → topological_space E} (H : ∀ i, @with_seminorms 𝕜 E (ι' i) _ _ _ _ (Q i) (T i))
  (H' : ∀ i, @topological_add_group E (T i) _) :
  @with_seminorms 𝕜 E (Σ i, ι' i) _ _ _ (hι.cases_on $ λ i, nonempty_sigma.mpr ⟨i, hι' i⟩)
  (seminorm_family.Union Q) (⨅ i, T i) :=
begin
  simp [seminorm_family.with_seminorms_iff_nhds_eq_infi] at H,
  letI : nonempty (Σ i, ι' i) := (hι.cases_on $ λ i, nonempty_sigma.mpr ⟨i, hι' i⟩),
  letI : topological_space E := ⨅ i, T i,
  letI : topological_add_group E := topological_add_group_infi H',
  rw [(seminorm_family.Union Q).with_seminorms_iff_nhds_eq_infi, nhds_infi, infi_sigma],
  refine infi_congr (λ i, _),
  rw [H i],
  exact infi_congr (λ hi, rfl)
end

lemma seminorm.nhds_0_comap_sup (p q : seminorm 𝕜 E) :
  (𝓝 0).comap (p ⊔ q : seminorm 𝕜 E) = (𝓝 0).comap p ⊓ (𝓝 0).comap q :=
begin
  rw (metric.nhds_basis_ball.comap (_)).ext ((metric.nhds_basis_ball.comap p).inf (metric.nhds_basis_ball.comap q)),
  { refine λ ε hε, ⟨⟨ε, ε⟩, ⟨hε, hε⟩, _⟩,
    dsimp only,
    rw [← p.ball_eq_preimage_ball hε, ← q.ball_eq_preimage_ball hε, ← seminorm.ball_sup,
        (p ⊔ q).ball_eq_preimage_ball hε] },
  { rintros ⟨ε₁, ε₂⟩ ⟨hε₁, hε₂⟩,
    have hε : 0 < min ε₁ ε₂ := lt_min hε₁ hε₂,
    refine ⟨min ε₁ ε₂, hε, _⟩,
    dsimp only,
    rw [← (p ⊔ q).ball_eq_preimage_ball hε, seminorm.ball_sup, p.ball_eq_preimage_ball hε,
        q.ball_eq_preimage_ball hε],
    exact inter_subset_inter
      (preimage_mono $ metric.ball_subset_ball $ min_le_left _ _)
      (preimage_mono $ metric.ball_subset_ball $ min_le_right _ _) }
end

lemma comap_const_of_mem' {α β : Type*} {x : α} {f : filter α} (h : ∀ V ∈ f, x ∈ V) : comap (λ y : β, x) f = ⊤ :=
begin
  ext W,
  suffices : (∃ (t : set α), t ∈ f ∧ (λ (y : β), x) ⁻¹' t ⊆ W) ↔ W = univ,
  by simpa,
  split,
  { rintro ⟨V, V_in, hW⟩,
    simpa [preimage_const_of_mem (h V V_in),  univ_subset_iff] using hW },
  { rintro rfl,
    use univ,
    simp [univ_mem] },
end

lemma seminorm_family.nhds_0_comap_finset_sup (p : seminorm_family 𝕜 E ι) (s : finset ι) :
  (𝓝 0).comap (s.sup p : seminorm 𝕜 E) = s.inf (λ i, (𝓝 0).comap (p i)) :=
begin
  classical,
  refine s.induction_on _ _,
  { rw [finset.sup_empty, finset.inf_empty, seminorm.bot_eq_zero, seminorm.coe_zero,
        pi.zero_def, comap_const_of_mem'],
    exact λ V, mem_of_mem_nhds },
  { intros i t hit h,
    rw [finset.sup_insert, finset.inf_insert, seminorm.nhds_0_comap_sup, h] }
end

lemma seminorm.is_bounded_iff_of_directed_dom [nonempty ι] {ι' : Type*}
  (p : seminorm_family 𝕜 E ι) (q : seminorm_family 𝕜 F ι') (f : E →ₗ[𝕜] F)
  (h : directed (≤) p) :
  seminorm.is_bounded p q f ↔ ∀ j, ∃ i : ι, ∃ C : ℝ≥0, C ≠ 0 ∧ (q j).comp f ≤ C • (p i) :=
begin
  rw [seminorm.is_bounded, forall_congr],
  intros j,
  split,
  { rintros ⟨s, C, hC, hle⟩,
    rcases h.finset_le s with ⟨i, hi⟩,
    rw ← finset.sup_le_iff at hi,
    exact ⟨i, C, hC, hle.trans (seminorm.smul_le_smul hi le_rfl)⟩ },
  { rintros ⟨i, C, hC, hle⟩,
    refine ⟨{i}, C, hC, _⟩,
    rwa finset.sup_singleton }
end

lemma seminorm.finset_sup_apply' (p : ι → seminorm 𝕜 F) {s : finset ι} (hs : s.nonempty) (x : F) :
  s.sup p x = s.sup' hs (λ i, p i x) :=
begin
  refine finset.nonempty.cons_induction _ _ hs,
  { intros i,
    rw [finset.sup_singleton, finset.sup'_singleton] },
  { intros i s his hs ih,
    rw [finset.sup_cons, finset.sup'_cons hs, seminorm.sup_apply, ih] }
end

--section unique
--
--variables [unique ι] [t : topological_space E] (p : seminorm_family 𝕜 E ι) [with_seminorms p]
--
--def with_seminorms.to_pseudo_metric_space : has_dist E :=
--{  }
--
--def with_seminorms.to_semi_normed_group : semi_normed_group E :=
--{  }
--
--def with_seminorms.to_normed_space_of_singleton_of_t2 [t : topological_space E]
--
--end unique

--lemma with_seminorms_sup_of_fintype [fintype ι] [hι : nonempty ι]
--  {p : seminorm_family 𝕜 F ι} [with_seminorms p] :
--  with_seminorms (λ u : unit, finset.univ.sup p) :=
--begin
--  sorry
--end

end any_field

--lemma finset.with_seminorms_inf {q : seminorm}


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/
import data.nat.basic

/-!
# Lists as Functions

Definitions for using lists as finite representations of finitely-supported functions with domain
ℕ.

These include pointwise operations on lists, as well as get and set operations.

## Notations

An index notation is introduced in this file for setting a particular element of a list. With `as`
as a list `m` as an index, and `a` as a new element, the notation is `as {m ↦ a}`.

So, for example
`[1, 3, 5] {1 ↦ 9}` would result in `[1, 9, 5]`

This notation is in the locale `list.func`.
-/

open list

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

namespace list
namespace func

variables {a : α}
variables {as as1 as2 as3 : list α}

/-- Elementwise negation of a list -/
def neg [has_neg α] (as : list α) := as.map (λ a, -a)

variables [inhabited α] [inhabited β]

/--
Update element of a list by index. If the index is out of range, extend the list with default
elements
-/
@[simp] def set (a : α) : list α → ℕ → list α
| (_::as) 0     := a::as
| []      0     := [a]
| (h::as) (k+1) := h::(set as k)
| []      (k+1) := (default α)::(set ([] : list α) k)

localized "notation as ` {` m ` ↦ ` a `}` := list.func.set a as m" in list.func

/-- Get element of a list by index. If the index is out of range, return the default element -/
@[simp] def get : ℕ → list α → α
| _ []          := default α
| 0 (a::as)     := a
| (n+1) (a::as) := get n as

/--
Pointwise equality of lists. If lists are different lengths, compare with the default
element.
-/
def equiv (as1 as2 : list α) : Prop :=
∀ (m : nat), get m as1 = get m as2

/-- Pointwise operations on lists. If lists are different lengths, use the default element. -/
@[simp] def pointwise (f : α → β → γ) : list α → list β → list γ
| []      []      := []
| []      (b::bs) := map (f $ default α) (b::bs)
| (a::as) []      := map (λ x, f x $ default β) (a::as)
| (a::as) (b::bs) := (f a b)::(pointwise as bs)

/-- Pointwise addition on lists. If lists are different lengths, use zero. -/
def add {α : Type u} [has_zero α] [has_add α] : list α → list α → list α :=
@pointwise α α α ⟨0⟩ ⟨0⟩ (+)

/-- Pointwise subtraction on lists. If lists are different lengths, use zero. -/
def sub {α : Type u} [has_zero α] [has_sub α] : list α → list α → list α :=
@pointwise α α α ⟨0⟩ ⟨0⟩ (@has_sub.sub α _)

/- set -/

lemma length_set : ∀ {m : ℕ} {as : list α},
  (as {m ↦ a}).length = max as.length (m+1)
| 0 []          := rfl
| 0 (a::as)     := by {rw max_eq_left, refl, simp [nat.le_add_right]}
| (m+1) []      := by simp only [set, nat.zero_max, length, @length_set m]
| (m+1) (a::as) := by simp only [set, nat.max_succ_succ, length, @length_set m]

@[simp] lemma get_nil {k : ℕ} : get k [] = default α :=
by {cases k; refl}

lemma get_eq_default_of_le :
  ∀ (k : ℕ) {as : list α}, as.length ≤ k → get k as = default α
| 0     []      h1 := rfl
| 0     (a::as) h1 := by cases h1
| (k+1) []      h1 := rfl
| (k+1) (a::as) h1 :=
  begin
    apply get_eq_default_of_le k,
    rw ← nat.succ_le_succ_iff, apply h1,
  end

@[simp] lemma get_set {a : α} :
  ∀ {k : ℕ} {as : list α}, get k (as {k ↦ a}) = a
| 0 as     := by {cases as; refl, }
| (k+1) as := by {cases as; simp [get_set]}

lemma eq_get_of_mem {a : α} :
  ∀ {as : list α}, a ∈ as → ∃ n : nat, ∀ d : α, a = (get n as)
| [] h := by cases h
| (b::as) h :=
  begin
    rw mem_cons_iff at h, cases h,
    { existsi 0, intro d, apply h },
    { cases eq_get_of_mem h with n h2,
      existsi (n+1), apply h2 }
  end

lemma mem_get_of_le :
  ∀ {n : ℕ} {as : list α}, n < as.length → get n as ∈ as
| _ [] h1 := by cases h1
| 0 (a::as) _ := or.inl rfl
| (n+1) (a::as) h1 :=
  begin
    apply or.inr, unfold get,
    apply mem_get_of_le,
    apply nat.lt_of_succ_lt_succ h1,
  end

lemma mem_get_of_ne_zero :
  ∀ {n : ℕ} {as : list α},
  get n as ≠ default α → get n as ∈ as
| _ [] h1 := begin exfalso, apply h1, rw get_nil end
| 0 (a::as) h1 := or.inl rfl
| (n+1) (a::as) h1 :=
  begin
    unfold get,
    apply (or.inr (mem_get_of_ne_zero _)),
    apply h1
  end

lemma get_set_eq_of_ne {a : α} :
  ∀ {as : list α} (k : ℕ) (m : ℕ),
  m ≠ k → get m (as {k ↦ a}) = get m as
| as 0 m h1 :=
  by { cases m, contradiction, cases as;
       simp only [set, get, get_nil] }
| as (k+1) m h1 :=
  begin
    cases as; cases m,
    simp only [set, get],
    { have h3 : get m (nil {k ↦ a}) = default α,
      { rw [get_set_eq_of_ne k m, get_nil],
        intro hc, apply h1, simp [hc] },
      apply h3 },
    simp only [set, get],
    { apply get_set_eq_of_ne k m,
      intro hc, apply h1, simp [hc], }
  end

lemma get_map {f : α → β} : ∀ {n : ℕ} {as : list α}, n < as.length →
  get n (as.map f) = f (get n as)
| _ [] h := by cases h
| 0 (a::as) h := rfl
| (n+1) (a::as) h1 :=
  begin
    have h2 : n < length as,
    { rw [← nat.succ_le_iff, ← nat.lt_succ_iff],
      apply h1 },
    apply get_map h2,
  end

lemma get_map' {f : α → β} {n : ℕ} {as : list α} :
  f (default α) = (default β) →
  get n (as.map f) = f (get n as) :=
begin
  intro h1, by_cases h2 : n < as.length,
  { apply get_map h2, },
  { rw not_lt at h2,
    rw [get_eq_default_of_le _ h2, get_eq_default_of_le, h1],
    rw [length_map], apply h2 }
end

lemma forall_val_of_forall_mem {as : list α} {p : α → Prop} :
  p (default α) → (∀ x ∈ as, p x) → (∀ n, p (get n as)) :=
begin
  intros h1 h2 n,
  by_cases h3 : n < as.length,
  { apply h2 _ (mem_get_of_le h3) },
  { rw not_lt at h3,
    rw get_eq_default_of_le _ h3, apply h1 }
end

/- equiv -/

lemma equiv_refl : equiv as as := λ k, rfl

lemma equiv_symm : equiv as1 as2 → equiv as2 as1 :=
λ h1 k, (h1 k).symm

lemma equiv_trans :
  equiv as1 as2 → equiv as2 as3 → equiv as1 as3 :=
λ h1 h2 k, eq.trans (h1 k) (h2 k)

lemma equiv_of_eq : as1 = as2 → equiv as1 as2 :=
begin intro h1, rw h1, apply equiv_refl end

lemma eq_of_equiv : ∀ {as1 as2 : list α}, as1.length = as2.length →
  equiv as1 as2 → as1 = as2
| []     [] h1 h2 := rfl
| (_::_) [] h1 h2 := by cases h1
| [] (_::_) h1 h2 := by cases h1
| (a1::as1) (a2::as2) h1 h2 :=
  begin
    congr,
    { apply h2 0 },
    have h3 : as1.length = as2.length,
    { simpa [add_left_inj, add_comm, length] using h1 },
    apply eq_of_equiv h3,
    intro m, apply h2 (m+1)
  end

end func
-- We want to drop the `inhabited` instances for a moment,
-- so we close and open the namespace

namespace func

/- neg -/

@[simp] lemma get_neg [add_group α] {k : ℕ} {as : list α} :
  @get α ⟨0⟩ k (neg as) = -(@get α ⟨0⟩ k as) :=
by {unfold neg, rw (@get_map' α α ⟨0⟩), apply neg_zero}

@[simp] lemma length_neg [has_neg α] (as : list α) : (neg as).length = as.length :=
by simp only [neg, length_map]

variables [inhabited α] [inhabited β]

/- pointwise -/

lemma nil_pointwise {f : α → β → γ} : ∀ bs : list β, pointwise f [] bs = bs.map (f $ default α)
| []      := rfl
| (b::bs) :=
  by simp only [nil_pointwise bs, pointwise,
     eq_self_iff_true, and_self, map]

lemma pointwise_nil {f : α → β → γ} :
  ∀ as : list α, pointwise f as [] = as.map (λ a, f a $ default β)
| []      := rfl
| (a::as) :=
  by simp only [pointwise_nil as, pointwise,
     eq_self_iff_true, and_self, list.map]

lemma get_pointwise [inhabited γ] {f : α → β → γ} (h1 : f (default α) (default β) = default γ) :
  ∀ (k : nat) (as : list α) (bs : list β),
  get k (pointwise f as bs) = f (get k as) (get k bs)
| k [] [] := by simp only [h1, get_nil, pointwise, get]
| 0 [] (b::bs) :=
  by simp only [get_pointwise, get_nil,
      pointwise, get, nat.nat_zero_eq_zero, map]
| (k+1) [] (b::bs) :=
  by { have : get k (map (f $ default α) bs) = f (default α) (get k bs),
       { simpa [nil_pointwise, get_nil] using (get_pointwise k [] bs) },
       simpa [get, get_nil, pointwise, map] }
| 0 (a::as) [] :=
  by simp only [get_pointwise, get_nil,
     pointwise, get, nat.nat_zero_eq_zero, map]
| (k+1) (a::as) [] :=
  by simpa [get, get_nil, pointwise, map, pointwise_nil, get_nil]
     using get_pointwise k as []
| 0 (a::as) (b::bs) := by simp only [pointwise, get]
| (k+1) (a::as) (b::bs) :=
  by simp only [pointwise, get, get_pointwise k]

lemma length_pointwise {f : α → β → γ} :
  ∀ {as : list α} {bs : list β},
  (pointwise f as bs).length = max as.length bs.length
| []      []      := rfl
| []      (b::bs) :=
  by simp only [pointwise, length, length_map,
     max_eq_right (nat.zero_le (length bs + 1))]
| (a::as) []      :=
  by simp only [pointwise, length, length_map,
     max_eq_left (nat.zero_le (length as + 1))]
| (a::as) (b::bs) :=
  by simp only [pointwise, length,
     nat.max_succ_succ, @length_pointwise as bs]

end func

namespace func
/- add -/

@[simp] lemma get_add {α : Type u} [add_monoid α] {k : ℕ} {xs ys : list α} :
  @get α ⟨0⟩ k (add xs ys) = ( @get α ⟨0⟩ k xs + @get α ⟨0⟩ k ys) :=
by {apply get_pointwise, apply zero_add}

@[simp] lemma length_add {α : Type u}
  [has_zero α] [has_add α] {xs ys : list α} :
  (add xs ys).length = max xs.length ys.length :=
@length_pointwise α α α ⟨0⟩ ⟨0⟩ _ _ _

@[simp]

@[simp] lemma add_nil {α : Type u} [add_monoid α]
  (as : list α) : add as [] = as :=
begin
  rw [add, @pointwise_nil α α α ⟨0⟩ ⟨0⟩],
  apply eq.trans _ (map_id as),
  congr' with x,
  have : @default α ⟨0⟩ = 0 := rfl,
  rw [this, add_zero], refl
end

lemma map_add_map {α : Type u} [add_monoid α] (f g : α → α) {as : list α} :
  add (as.map f) (as.map g) = as.map (λ x, f x + g x) :=
begin
  apply @eq_of_equiv _ (⟨0⟩ : inhabited α),
  { rw [length_map, length_add, max_eq_left, length_map],
    apply le_of_eq,
    rw [length_map, length_map] },
  intros m,
  rw [get_add],
  by_cases h : m < length as,
  { repeat {rw [@get_map α α ⟨0⟩ ⟨0⟩ _ _ _ h]} },
  rw not_lt at h,
  repeat {rw [get_eq_default_of_le m]};
  try {rw length_map, apply h},
  apply zero_add
end

/- sub -/

@[simp] lemma get_sub {α : Type u}
  [add_group α] {k : ℕ} {xs ys : list α} :
  @get α ⟨0⟩ k (sub xs ys) = (@get α ⟨0⟩ k xs - @get α ⟨0⟩ k ys) :=
by {apply get_pointwise, apply sub_zero}

@[simp] lemma length_sub [has_zero α] [has_sub α] {xs ys : list α} :
  (sub xs ys).length = max xs.length ys.length :=
@length_pointwise α α α ⟨0⟩ ⟨0⟩ _ _ _

@[simp] lemma nil_sub {α : Type} [add_group α]
  (as : list α) : sub [] as = neg as :=
begin
  rw [sub, nil_pointwise],
  congr' with x,
  have : @default α ⟨0⟩ = 0 := rfl,
  rw [this, zero_sub]
end

@[simp] lemma sub_nil {α : Type} [add_group α]
  (as : list α) : sub as [] = as :=
begin
  rw [sub, pointwise_nil],
  apply eq.trans _ (map_id as),
  congr' with x,
  have : @default α ⟨0⟩ = 0 := rfl,
  rw [this, sub_zero], refl
end

end func
end list


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.algebra_map
import Mathlib.data.polynomial.monic
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Theory of monic polynomials

We define `integral_normalization`, which relate arbitrary polynomials to monic ones.
-/

namespace polynomial

/-- If `f : polynomial R` is a nonzero polynomial with root `z`, `integral_normalization f` is
a monic polynomial with root `leading_coeff f * z`.

Moreover, `integral_normalization 0 = 0`.
-/
def integral_normalization {R : Type u} [semiring R] (f : polynomial R) : polynomial R :=
  finsupp.on_finset (finsupp.support f)
    (fun (i : ℕ) => ite (degree f = ↑i) 1 (coeff f i * leading_coeff f ^ (nat_degree f - 1 - i)))
    sorry

theorem integral_normalization_coeff_degree {R : Type u} [semiring R] {f : polynomial R} {i : ℕ}
    (hi : degree f = ↑i) : coeff (integral_normalization f) i = 1 :=
  if_pos hi

theorem integral_normalization_coeff_nat_degree {R : Type u} [semiring R] {f : polynomial R}
    (hf : f ≠ 0) : coeff (integral_normalization f) (nat_degree f) = 1 :=
  integral_normalization_coeff_degree (degree_eq_nat_degree hf)

theorem integral_normalization_coeff_ne_degree {R : Type u} [semiring R] {f : polynomial R} {i : ℕ}
    (hi : degree f ≠ ↑i) :
    coeff (integral_normalization f) i = coeff f i * leading_coeff f ^ (nat_degree f - 1 - i) :=
  if_neg hi

theorem integral_normalization_coeff_ne_nat_degree {R : Type u} [semiring R] {f : polynomial R}
    {i : ℕ} (hi : i ≠ nat_degree f) :
    coeff (integral_normalization f) i = coeff f i * leading_coeff f ^ (nat_degree f - 1 - i) :=
  integral_normalization_coeff_ne_degree (degree_ne_of_nat_degree_ne (ne.symm hi))

theorem monic_integral_normalization {R : Type u} [semiring R] {f : polynomial R} (hf : f ≠ 0) :
    monic (integral_normalization f) :=
  sorry

@[simp] theorem support_integral_normalization {R : Type u} [integral_domain R] {f : polynomial R}
    (hf : f ≠ 0) : finsupp.support (integral_normalization f) = finsupp.support f :=
  sorry

theorem integral_normalization_eval₂_eq_zero {R : Type u} {S : Type v} [integral_domain R]
    [comm_ring S] {p : polynomial R} (hp : p ≠ 0) (f : R →+* S) {z : S} (hz : eval₂ f z p = 0)
    (inj : ∀ (x : R), coe_fn f x = 0 → x = 0) :
    eval₂ f (z * coe_fn f (leading_coeff p)) (integral_normalization p) = 0 :=
  sorry

theorem integral_normalization_aeval_eq_zero {R : Type u} {S : Type v} [integral_domain R]
    [comm_ring S] [algebra R S] {f : polynomial R} (hf : f ≠ 0) {z : S}
    (hz : coe_fn (aeval z) f = 0) (inj : ∀ (x : R), coe_fn (algebra_map R S) x = 0 → x = 0) :
    coe_fn (aeval (z * coe_fn (algebra_map R S) (leading_coeff f))) (integral_normalization f) =
        0 :=
  integral_normalization_eval₂_eq_zero hf (algebra_map R S) hz inj

end Mathlib


import category_theory.shift
import algebra.homology.homological_complex
import algebra.homology.homotopy_category
import data.int.parity
import tactic.ring
import category_theory.arrow
import category_theory.preadditive

local attribute [simp] category_theory.preadditive.zsmul_comp category_theory.preadditive.comp_zsmul

-- move this section
namespace int

def neg_one_pow (n : ℤ) : ℤ := @has_pow.pow (units ℤ) ℤ _ (-1) n

@[simp] lemma neg_one_pow_add (n m : ℤ) : neg_one_pow (n + m) = neg_one_pow n * neg_one_pow m :=
by { delta neg_one_pow, rw zpow_add, simp }

@[simp] lemma neg_one_pow_one : neg_one_pow 1 = -1 := rfl

-- This lemma is provable by `neg_one_pow_neg`, but it is nice to have a rfl-lemma for this.
-- The priority is thus higher to silence the linter.
@[simp, priority 1100] lemma neg_one_pow_neg_one : neg_one_pow (-1) = -1 := rfl

@[simp] lemma neg_one_pow_neg_zero : neg_one_pow 0 = 1 := rfl

lemma neg_one_pow_ite (n : ℤ) : neg_one_pow n = if even n then 1 else -1 :=
begin
  induction n using int.induction_on with n h n h,
  { simp [neg_one_pow] },
  { simp [h, apply_ite has_neg.neg] with parity_simps },
  { rw [sub_eq_add_neg, neg_one_pow_add],
    simp [h, apply_ite has_neg.neg] with parity_simps }
end

lemma neg_one_pow_even {n : ℤ} (h : even n) : neg_one_pow n = 1 :=
by rw [neg_one_pow_ite, if_pos h]

lemma neg_one_pow_odd {n : ℤ} (h : odd n) : neg_one_pow n = -1 :=
by rw [neg_one_pow_ite, if_neg (odd_iff_not_even.mp h)]

@[simp] lemma neg_one_pow_bit0 (n : ℤ) : neg_one_pow (bit0 n) = 1 :=
neg_one_pow_even (even_bit0 n)

@[simp] lemma neg_one_pow_bit1 (n : ℤ) : neg_one_pow (bit1 n) = -1 :=
neg_one_pow_odd (odd_bit1 n)

lemma neg_one_pow_eq_pow_abs (n : ℤ) : neg_one_pow n = (-1) ^ n.nat_abs :=
begin
  rw neg_one_pow_ite,
  convert (neg_one_pow_ite n.nat_abs).symm using 2,
  { simp with parity_simps },
  { delta neg_one_pow, simp }
end

lemma neg_one_pow_eq_neg_one_npow (n : ℕ) : neg_one_pow n = (-1) ^ n :=
by { delta neg_one_pow, simp }

@[simp] lemma neg_one_pow_neg (n : ℤ) : neg_one_pow (-n) = neg_one_pow n :=
by simp [neg_one_pow_ite] with parity_simps

@[simp] lemma neg_one_pow_sub (n m : ℤ) : neg_one_pow (n - m) = neg_one_pow n * neg_one_pow m :=
by rw [sub_eq_neg_add, neg_one_pow_add, neg_one_pow_neg, mul_comm]

@[simp] lemma neg_one_pow_mul_self (n : ℤ) : neg_one_pow n * neg_one_pow n = 1 :=
by { delta neg_one_pow, simp }

@[simp] lemma neg_one_pow_smul_self {α : Type*} [add_comm_group α] (n : ℤ) (X : α) :
  neg_one_pow n • neg_one_pow n • X = X :=
by simp [smul_smul]

open category_theory

variables {A : Type*} [category A] [preadditive A]

@[simps]
def neg_one_pow_smul_iso (n : ℤ) {X Y : A} (e : X ≅ Y) : X ≅ Y :=
{ hom := n.neg_one_pow • e.hom,
  inv := n.neg_one_pow • e.inv }

@[simps]
def neg_one_pow_arrow_iso_left (n : ℤ) {X Y : A} (f : X ⟶ Y) :
  arrow.mk f ≅ arrow.mk (n.neg_one_pow • f) :=
arrow.iso_mk (n.neg_one_pow_smul_iso (iso.refl _)) (iso.refl _) (by { dsimp, simp })

@[simps]
def neg_one_pow_arrow_iso_right (n : ℤ) {X Y : A} (f : X ⟶ Y) :
  arrow.mk f ≅ arrow.mk (n.neg_one_pow • f) :=
arrow.iso_mk (iso.refl _) (n.neg_one_pow_smul_iso (iso.refl _)) (by { dsimp, simp })

end int


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

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

/-!
# Derivatives of integrals depending on parameters

A parametric integral is a function with shape `f = λ x : H, ∫ a : α, F x a ∂μ` for some
`F : H → α → E`, where `H` and `E` are normed spaces and `α` is a measured space with measure `μ`.

We already know from `continuous_of_dominated` in `measure_theory.integral.bochner` how to
guarantee that `f` is continuous using the dominated convergence theorem. In this file,
we want to express the derivative of `f` as the integral of the derivative of `F` with respect
to `x`.

## Main results

As explained above, all results express the derivative of a parametric integral as the integral of
a derivative. The variations come from the assumptions and from the different ways of expressing
derivative, especially Fréchet derivatives vs elementary derivative of function of one real
variable.

* `has_fderiv_at_integral_of_dominated_loc_of_lip`: this version assumes that
  - `F x` is ae-measurable for x near `x₀`,
  - `F x₀` is integrable,
  - `λ x, F x a` has derivative `F' a : H →L[ℝ] E` at `x₀` which is ae-measurable,
  - `λ x, F x a` is locally Lipschitz near `x₀` for almost every `a`, with a Lipschitz bound which
    is integrable with respect to `a`.

  A subtle point is that the "near x₀" in the last condition has to be uniform in `a`. This is
  controlled by a positive number `ε`.

* `has_fderiv_at_integral_of_dominated_of_fderiv_le`: this version assume `λ x, F x a` has
   derivative `F' x a` for `x` near `x₀` and `F' x` is bounded by an integrable function independent
   from `x` near `x₀`.

`has_deriv_at_integral_of_dominated_loc_of_lip` and
`has_deriv_at_integral_of_dominated_loc_of_deriv_le` are versions of the above two results that
assume `H = ℝ` or `H = ℂ` and use the high-school derivative `deriv` instead of Fréchet derivative
`fderiv`.

We also provide versions of these theorems for set integrals.

## Tags
integral, derivative
-/

noncomputable section

open TopologicalSpace MeasureTheory Filter Metric

open Topology Filter

variable {α : Type _} [MeasurableSpace α] {μ : Measure α} {𝕜 : Type _} [IsROrC 𝕜] {E : Type _}
  [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedSpace 𝕜 E] [CompleteSpace E] {H : Type _}
  [NormedAddCommGroup H] [NormedSpace 𝕜 H]

/-- Differentiation under integral of `x ↦ ∫ F x a` at a given point `x₀`, assuming `F x₀` is
integrable, `‖F x a - F x₀ a‖ ≤ bound a * ‖x - x₀‖` for `x` in a ball around `x₀` for ae `a` with
integrable Lipschitz bound `bound` (with a ball radius independent of `a`), and `F x` is
ae-measurable for `x` in the same ball. See `has_fderiv_at_integral_of_dominated_loc_of_lip` for a
slightly less general but usually more useful version. -/
theorem hasFderivAt_integral_of_dominated_loc_of_lip' {F : H → α → E} {F' : α → H →L[𝕜] E} {x₀ : H}
    {bound : α → ℝ} {ε : ℝ} (ε_pos : 0 < ε)
    (hF_meas : ∀ x ∈ ball x₀ ε, AeStronglyMeasurable (F x) μ) (hF_int : Integrable (F x₀) μ)
    (hF'_meas : AeStronglyMeasurable F' μ)
    (h_lipsch : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F x a - F x₀ a‖ ≤ bound a * ‖x - x₀‖)
    (bound_integrable : Integrable (bound : α → ℝ) μ)
    (h_diff : ∀ᵐ a ∂μ, HasFderivAt (fun x => F x a) (F' a) x₀) :
    Integrable F' μ ∧ HasFderivAt (fun x => ∫ a, F x a ∂μ) (∫ a, F' a ∂μ) x₀ :=
  by
  have x₀_in : x₀ ∈ ball x₀ ε := mem_ball_self ε_pos
  have nneg : ∀ x, 0 ≤ ‖x - x₀‖⁻¹ := fun x => inv_nonneg.mpr (norm_nonneg _)
  set b : α → ℝ := fun a => |bound a|
  have b_int : integrable b μ := bound_integrable.norm
  have b_nonneg : ∀ a, 0 ≤ b a := fun a => abs_nonneg _
  replace h_lipsch : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F x a - F x₀ a‖ ≤ b a * ‖x - x₀‖
  exact
    h_lipsch.mono fun a ha x hx =>
      (ha x hx).trans <| mul_le_mul_of_nonneg_right (le_abs_self _) (norm_nonneg _)
  have hF_int' : ∀ x ∈ ball x₀ ε, integrable (F x) μ :=
    by
    intro x x_in
    have : ∀ᵐ a ∂μ, ‖F x₀ a - F x a‖ ≤ ε * b a :=
      by
      simp only [norm_sub_rev (F x₀ _)]
      refine' h_lipsch.mono fun a ha => (ha x x_in).trans _
      rw [mul_comm ε]
      rw [mem_ball, dist_eq_norm] at x_in
      exact mul_le_mul_of_nonneg_left x_in.le (b_nonneg _)
    exact
      integrable_of_norm_sub_le (hF_meas x x_in) hF_int
        (integrable.const_mul bound_integrable.norm ε) this
  have hF'_int : integrable F' μ :=
    haveI : ∀ᵐ a ∂μ, ‖F' a‖ ≤ b a :=
      by
      apply (h_diff.and h_lipsch).mono
      rintro a ⟨ha_diff, ha_lip⟩
      refine' ha_diff.le_of_lip' (b_nonneg a) (mem_of_superset (ball_mem_nhds _ ε_pos) <| ha_lip)
    b_int.mono' hF'_meas this
  refine' ⟨hF'_int, _⟩
  have h_ball : ball x₀ ε ∈ 𝓝 x₀ := ball_mem_nhds x₀ ε_pos
  have :
    ∀ᶠ x in 𝓝 x₀,
      ‖x - x₀‖⁻¹ * ‖((∫ a, F x a ∂μ) - ∫ a, F x₀ a ∂μ) - (∫ a, F' a ∂μ) (x - x₀)‖ =
        ‖∫ a, ‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀)) ∂μ‖ :=
    by
    apply mem_of_superset (ball_mem_nhds _ ε_pos)
    intro x x_in
    rw [Set.mem_setOf_eq, ← norm_smul_of_nonneg (nneg _), integral_smul, integral_sub, integral_sub,
      ← ContinuousLinearMap.integral_apply hF'_int]
    exacts[hF_int' x x_in, hF_int, (hF_int' x x_in).sub hF_int,
      hF'_int.apply_continuous_linear_map _]
  rw [hasFderivAt_iff_tendsto, tendsto_congr' this, ← tendsto_zero_iff_norm_tendsto_zero, ←
    show (∫ a : α, ‖x₀ - x₀‖⁻¹ • (F x₀ a - F x₀ a - (F' a) (x₀ - x₀)) ∂μ) = 0 by simp]
  apply tendsto_integral_filter_of_dominated_convergence
  · filter_upwards [h_ball]with _ x_in
    apply ae_strongly_measurable.const_smul
    exact ((hF_meas _ x_in).sub (hF_meas _ x₀_in)).sub (hF'_meas.apply_continuous_linear_map _)
  · apply mem_of_superset h_ball
    intro x hx
    apply (h_diff.and h_lipsch).mono
    rintro a ⟨ha_deriv, ha_bound⟩
    show ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))‖ ≤ b a + ‖F' a‖
    replace ha_bound : ‖F x a - F x₀ a‖ ≤ b a * ‖x - x₀‖ := ha_bound x hx
    calc
      ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))‖ =
          ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a) - ‖x - x₀‖⁻¹ • F' a (x - x₀)‖ :=
        by rw [smul_sub]
      _ ≤ ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a)‖ + ‖‖x - x₀‖⁻¹ • F' a (x - x₀)‖ := (norm_sub_le _ _)
      _ = ‖x - x₀‖⁻¹ * ‖F x a - F x₀ a‖ + ‖x - x₀‖⁻¹ * ‖F' a (x - x₀)‖ := by
        rw [norm_smul_of_nonneg, norm_smul_of_nonneg] <;> exact nneg _
      _ ≤ ‖x - x₀‖⁻¹ * (b a * ‖x - x₀‖) + ‖x - x₀‖⁻¹ * (‖F' a‖ * ‖x - x₀‖) := (add_le_add _ _)
      _ ≤ b a + ‖F' a‖ := _

    exact mul_le_mul_of_nonneg_left ha_bound (nneg _)
    apply mul_le_mul_of_nonneg_left ((F' a).le_opNorm _) (nneg _)
    by_cases h : ‖x - x₀‖ = 0
    · simpa [h] using add_nonneg (b_nonneg a) (norm_nonneg (F' a))
    · field_simp [h]
  · exact b_int.add hF'_int.norm
  · apply h_diff.mono
    intro a ha
    suffices tendsto (fun x => ‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))) (𝓝 x₀) (𝓝 0) by simpa
    rw [tendsto_zero_iff_norm_tendsto_zero]
    have :
      (fun x => ‖x - x₀‖⁻¹ * ‖F x a - F x₀ a - F' a (x - x₀)‖) = fun x =>
        ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))‖ :=
      by
      ext x
      rw [norm_smul_of_nonneg (nneg _)]
    rwa [hasFderivAt_iff_tendsto, this] at ha
#align has_fderiv_at_integral_of_dominated_loc_of_lip' hasFderivAt_integral_of_dominated_loc_of_lip'

/-- Differentiation under integral of `x ↦ ∫ F x a` at a given point `x₀`, assuming
`F x₀` is integrable, `x ↦ F x a` is locally Lipschitz on a ball around `x₀` for ae `a`
(with a ball radius independent of `a`) with integrable Lipschitz bound, and `F x` is ae-measurable
for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasFderivAt_integral_of_dominated_loc_of_lip {F : H → α → E} {F' : α → H →L[𝕜] E} {x₀ : H}
    {bound : α → ℝ} {ε : ℝ} (ε_pos : 0 < ε) (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) μ)
    (hF_int : Integrable (F x₀) μ) (hF'_meas : AeStronglyMeasurable F' μ)
    (h_lip : ∀ᵐ a ∂μ, LipschitzOnWith (Real.nnabs <| bound a) (fun x => F x a) (ball x₀ ε))
    (bound_integrable : Integrable (bound : α → ℝ) μ)
    (h_diff : ∀ᵐ a ∂μ, HasFderivAt (fun x => F x a) (F' a) x₀) :
    Integrable F' μ ∧ HasFderivAt (fun x => ∫ a, F x a ∂μ) (∫ a, F' a ∂μ) x₀ :=
  by
  obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ x ∈ ball x₀ δ, ae_strongly_measurable (F x) μ ∧ x ∈ ball x₀ ε
  exact eventually_nhds_iff_ball.mp (hF_meas.and (ball_mem_nhds x₀ ε_pos))
  choose hδ_meas hδε using hδ
  replace h_lip : ∀ᵐ a : α ∂μ, ∀ x ∈ ball x₀ δ, ‖F x a - F x₀ a‖ ≤ |bound a| * ‖x - x₀‖
  exact h_lip.mono fun a lip x hx => lip.norm_sub_le (hδε x hx) (mem_ball_self ε_pos)
  replace bound_integrable := bound_integrable.norm
  apply hasFderivAt_integral_of_dominated_loc_of_lip' δ_pos <;> assumption
#align has_fderiv_at_integral_of_dominated_loc_of_lip hasFderivAt_integral_of_dominated_loc_of_lip

/-- Differentiation under integral of `x ↦ ∫ F x a` at a given point `x₀`, assuming
`F x₀` is integrable, `x ↦ F x a` is differentiable on a ball around `x₀` for ae `a` with
derivative norm uniformly bounded by an integrable function (the ball radius is independent of `a`),
and `F x` is ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasFderivAt_integral_of_dominated_of_fderiv_le {F : H → α → E} {F' : H → α → H →L[𝕜] E}
    {x₀ : H} {bound : α → ℝ} {ε : ℝ} (ε_pos : 0 < ε)
    (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) μ) (hF_int : Integrable (F x₀) μ)
    (hF'_meas : AeStronglyMeasurable (F' x₀) μ)
    (h_bound : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F' x a‖ ≤ bound a)
    (bound_integrable : Integrable (bound : α → ℝ) μ)
    (h_diff : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, HasFderivAt (fun x => F x a) (F' x a) x) :
    HasFderivAt (fun x => ∫ a, F x a ∂μ) (∫ a, F' x₀ a ∂μ) x₀ :=
  by
  letI : NormedSpace ℝ H := NormedSpace.restrictScalars ℝ 𝕜 H
  have x₀_in : x₀ ∈ ball x₀ ε := mem_ball_self ε_pos
  have diff_x₀ : ∀ᵐ a ∂μ, HasFderivAt (fun x => F x a) (F' x₀ a) x₀ :=
    h_diff.mono fun a ha => ha x₀ x₀_in
  have : ∀ᵐ a ∂μ, LipschitzOnWith (Real.nnabs (bound a)) (fun x => F x a) (ball x₀ ε) :=
    by
    apply (h_diff.and h_bound).mono
    rintro a ⟨ha_deriv, ha_bound⟩
    refine'
      (convex_ball _ _).lipschitzOnWith_of_nnnorm_has_fderiv_within_le
        (fun x x_in => (ha_deriv x x_in).HasFderivWithinAt) fun x x_in => _
    rw [← NNReal.coe_le_coe, coe_nnnorm, Real.coe_nnabs]
    exact (ha_bound x x_in).trans (le_abs_self _)
  exact
    (hasFderivAt_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas this
        bound_integrable diff_x₀).2
#align has_fderiv_at_integral_of_dominated_of_fderiv_le hasFderivAt_integral_of_dominated_of_fderiv_le

/-- Derivative under integral of `x ↦ ∫ F x a` at a given point `x₀ : 𝕜`, `𝕜 = ℝ` or `𝕜 = ℂ`,
assuming `F x₀` is integrable, `x ↦ F x a` is locally Lipschitz on a ball around `x₀` for ae `a`
(with ball radius independent of `a`) with integrable Lipschitz bound, and `F x` is
ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasDerivAt_integral_of_dominated_loc_of_lip {F : 𝕜 → α → E} {F' : α → E} {x₀ : 𝕜} {ε : ℝ}
    (ε_pos : 0 < ε) (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) μ)
    (hF_int : Integrable (F x₀) μ) (hF'_meas : AeStronglyMeasurable F' μ) {bound : α → ℝ}
    (h_lipsch : ∀ᵐ a ∂μ, LipschitzOnWith (Real.nnabs <| bound a) (fun x => F x a) (ball x₀ ε))
    (bound_integrable : Integrable (bound : α → ℝ) μ)
    (h_diff : ∀ᵐ a ∂μ, HasDerivAt (fun x => F x a) (F' a) x₀) :
    Integrable F' μ ∧ HasDerivAt (fun x => ∫ a, F x a ∂μ) (∫ a, F' a ∂μ) x₀ :=
  by
  set L : E →L[𝕜] 𝕜 →L[𝕜] E := ContinuousLinearMap.smulRightL 𝕜 𝕜 E 1
  replace h_diff : ∀ᵐ a ∂μ, HasFderivAt (fun x => F x a) (L (F' a)) x₀ :=
    h_diff.mono fun x hx => hx.HasFderivAt
  have hm : ae_strongly_measurable (L ∘ F') μ := L.continuous.comp_ae_strongly_measurable hF'_meas
  cases'
    hasFderivAt_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hm h_lipsch bound_integrable
      h_diff with
    hF'_int key
  replace hF'_int : integrable F' μ
  · rw [← integrable_norm_iff hm] at hF'_int
    simpa only [L, (· ∘ ·), integrable_norm_iff, hF'_meas, one_mul, norm_one,
      ContinuousLinearMap.comp_apply, ContinuousLinearMap.coe_restrict_scalarsL',
      ContinuousLinearMap.norm_restrictScalars, ContinuousLinearMap.norm_smulRightL_apply] using
      hF'_int
  refine' ⟨hF'_int, _⟩
  simp_rw [hasDerivAt_iff_hasFderivAt] at h_diff⊢
  rwa [ContinuousLinearMap.integral_comp_comm _ hF'_int] at key
  all_goals infer_instance
#align has_deriv_at_integral_of_dominated_loc_of_lip hasDerivAt_integral_of_dominated_loc_of_lip

/-- Derivative under integral of `x ↦ ∫ F x a` at a given point `x₀ : ℝ`, assuming
`F x₀` is integrable, `x ↦ F x a` is differentiable on an interval around `x₀` for ae `a`
(with interval radius independent of `a`) with derivative uniformly bounded by an integrable
function, and `F x` is ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasDerivAt_integral_of_dominated_loc_of_deriv_le {F : 𝕜 → α → E} {F' : 𝕜 → α → E} {x₀ : 𝕜}
    {ε : ℝ} (ε_pos : 0 < ε) (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) μ)
    (hF_int : Integrable (F x₀) μ) (hF'_meas : AeStronglyMeasurable (F' x₀) μ) {bound : α → ℝ}
    (h_bound : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F' x a‖ ≤ bound a) (bound_integrable : Integrable bound μ)
    (h_diff : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, HasDerivAt (fun x => F x a) (F' x a) x) :
    Integrable (F' x₀) μ ∧ HasDerivAt (fun n => ∫ a, F n a ∂μ) (∫ a, F' x₀ a ∂μ) x₀ :=
  by
  have x₀_in : x₀ ∈ ball x₀ ε := mem_ball_self ε_pos
  have diff_x₀ : ∀ᵐ a ∂μ, HasDerivAt (fun x => F x a) (F' x₀ a) x₀ :=
    h_diff.mono fun a ha => ha x₀ x₀_in
  have : ∀ᵐ a ∂μ, LipschitzOnWith (Real.nnabs (bound a)) (fun x : 𝕜 => F x a) (ball x₀ ε) :=
    by
    apply (h_diff.and h_bound).mono
    rintro a ⟨ha_deriv, ha_bound⟩
    refine'
      (convex_ball _ _).lipschitzOnWith_of_nnnorm_has_deriv_within_le
        (fun x x_in => (ha_deriv x x_in).HasDerivWithinAt) fun x x_in => _
    rw [← NNReal.coe_le_coe, coe_nnnorm, Real.coe_nnabs]
    exact (ha_bound x x_in).trans (le_abs_self _)
  exact
    hasDerivAt_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas this bound_integrable
      diff_x₀
#align has_deriv_at_integral_of_dominated_loc_of_deriv_le hasDerivAt_integral_of_dominated_loc_of_deriv_le