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

! This file was ported from Lean 3 source module analysis.box_integral.partition.tagged
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.BoxIntegral.Partition.Basic

/-!
# Tagged partitions

A tagged (pre)partition is a (pre)partition `π` enriched with a tagged point for each box of
‵π`. For simplicity we require that the function `box_integral.tagged_prepartition.tag` is defined
on all boxes `J : box ι` but use its values only on boxes of the partition. Given `π :
box_integral.tagged_partition I`, we require that each `box_integral.tagged_partition π J` belongs
to `box_integral.box.Icc I`. If for every `J ∈ π`, `π.tag J` belongs to `J.Icc`, then `π` is called
a *Henstock* partition. We do not include this assumption into the definition of a tagged
(pre)partition because McShane integral is defined as a limit along tagged partitions without this
requirement.

### Tags

rectangular box, box partition
-/

noncomputable section

open Classical ENNReal NNReal

open Set Function

namespace BoxIntegral

variable {ι : Type _}

/-- A tagged prepartition is a prepartition enriched with a tagged point for each box of the
prepartition. For simiplicity we require that `tag` is defined for all boxes in `ι → ℝ` but
we will use onle the values of `tag` on the boxes of the partition. -/
structure TaggedPrepartition (I : Box ι) extends Prepartition I where
  Tag : Box ι → ι → ℝ
  tag_mem_icc : ∀ J, tag J ∈ I.Icc
#align box_integral.tagged_prepartition BoxIntegral.TaggedPrepartition

namespace TaggedPrepartition

variable {I J J₁ J₂ : Box ι} (π : TaggedPrepartition I) {x : ι → ℝ}

instance : Membership (Box ι) (TaggedPrepartition I) :=
  ⟨fun J π => J ∈ π.boxes⟩

@[simp]
theorem mem_toPrepartition {π : TaggedPrepartition I} : J ∈ π.toPrepartition ↔ J ∈ π :=
  Iff.rfl
#align box_integral.tagged_prepartition.mem_to_prepartition BoxIntegral.TaggedPrepartition.mem_toPrepartition

@[simp]
theorem mem_mk (π : Prepartition I) (f h) : J ∈ mk π f h ↔ J ∈ π :=
  Iff.rfl
#align box_integral.tagged_prepartition.mem_mk BoxIntegral.TaggedPrepartition.mem_mk

/-- Union of all boxes of a tagged prepartition. -/
def union : Set (ι → ℝ) :=
  π.toPrepartition.unionᵢ
#align box_integral.tagged_prepartition.Union BoxIntegral.TaggedPrepartition.union

theorem union_def : π.unionᵢ = ⋃ J ∈ π, ↑J :=
  rfl
#align box_integral.tagged_prepartition.Union_def BoxIntegral.TaggedPrepartition.union_def

@[simp]
theorem union_mk (π : Prepartition I) (f h) : (mk π f h).unionᵢ = π.unionᵢ :=
  rfl
#align box_integral.tagged_prepartition.Union_mk BoxIntegral.TaggedPrepartition.union_mk

@[simp]
theorem union_toPrepartition : π.toPrepartition.unionᵢ = π.unionᵢ :=
  rfl
#align box_integral.tagged_prepartition.Union_to_prepartition BoxIntegral.TaggedPrepartition.union_toPrepartition

@[simp]
theorem mem_union : x ∈ π.unionᵢ ↔ ∃ J ∈ π, x ∈ J :=
  Set.mem_unionᵢ₂
#align box_integral.tagged_prepartition.mem_Union BoxIntegral.TaggedPrepartition.mem_union

theorem subset_union (h : J ∈ π) : ↑J ⊆ π.unionᵢ :=
  subset_bunionᵢ_of_mem h
#align box_integral.tagged_prepartition.subset_Union BoxIntegral.TaggedPrepartition.subset_union

theorem union_subset : π.unionᵢ ⊆ I :=
  unionᵢ₂_subset π.le_of_mem'
#align box_integral.tagged_prepartition.Union_subset BoxIntegral.TaggedPrepartition.union_subset

/-- A tagged prepartition is a partition if it covers the whole box. -/
def IsPartition :=
  π.toPrepartition.IsPartition
#align box_integral.tagged_prepartition.is_partition BoxIntegral.TaggedPrepartition.IsPartition

theorem isPartition_iff_union_eq : IsPartition π ↔ π.unionᵢ = I :=
  Prepartition.isPartition_iff_union_eq
#align box_integral.tagged_prepartition.is_partition_iff_Union_eq BoxIntegral.TaggedPrepartition.isPartition_iff_union_eq

/-- The tagged partition made of boxes of `π` that satisfy predicate `p`. -/
@[simps (config := { fullyApplied := false })]
def filter (p : Box ι → Prop) : TaggedPrepartition I :=
  ⟨π.1.filterₓ p, π.2, π.3⟩
#align box_integral.tagged_prepartition.filter BoxIntegral.TaggedPrepartition.filter

@[simp]
theorem mem_filter {p : Box ι → Prop} : J ∈ π.filterₓ p ↔ J ∈ π ∧ p J :=
  Finset.mem_filter
#align box_integral.tagged_prepartition.mem_filter BoxIntegral.TaggedPrepartition.mem_filter

@[simp]
theorem union_filter_not (π : TaggedPrepartition I) (p : Box ι → Prop) :
    (π.filterₓ fun J => ¬p J).unionᵢ = π.unionᵢ \ (π.filterₓ p).unionᵢ :=
  π.toPrepartition.union_filter_not p
#align box_integral.tagged_prepartition.Union_filter_not BoxIntegral.TaggedPrepartition.union_filter_not

end TaggedPrepartition

namespace Prepartition

variable {I J : Box ι}

/-- Given a partition `π` of `I : box_integral.box ι` and a collection of tagged partitions
`πi J` of all boxes `J ∈ π`, returns the tagged partition of `I` into all the boxes of `πi J`
with tags coming from `(πi J).tag`. -/
def bUnionTagged (π : Prepartition I) (πi : ∀ J, TaggedPrepartition J) : TaggedPrepartition I
    where
  toPrepartition := π.bunionᵢ fun J => (πi J).toPrepartition
  Tag J := (πi (π.bUnionIndex (fun J => (πi J).toPrepartition) J)).Tag J
  tag_mem_icc J := Box.le_iff_icc.1 (π.bUnionIndex_le _ _) ((πi _).tag_mem_icc _)
#align box_integral.prepartition.bUnion_tagged BoxIntegral.Prepartition.bUnionTagged

@[simp]
theorem mem_bUnionTagged (π : Prepartition I) {πi : ∀ J, TaggedPrepartition J} :
    J ∈ π.bUnionTagged πi ↔ ∃ J' ∈ π, J ∈ πi J' :=
  π.mem_bunionᵢ
#align box_integral.prepartition.mem_bUnion_tagged BoxIntegral.Prepartition.mem_bUnionTagged

theorem tag_bUnionTagged (π : Prepartition I) {πi : ∀ J, TaggedPrepartition J} (hJ : J ∈ π) {J'}
    (hJ' : J' ∈ πi J) : (π.bUnionTagged πi).Tag J' = (πi J).Tag J' :=
  by
  have : J' ∈ π.bUnion_tagged πi := π.mem_bUnion.2 ⟨J, hJ, hJ'⟩
  obtain rfl := π.bUnion_index_of_mem hJ hJ'
  rfl
#align box_integral.prepartition.tag_bUnion_tagged BoxIntegral.Prepartition.tag_bUnionTagged

@[simp]
theorem union_bUnionTagged (π : Prepartition I) (πi : ∀ J, TaggedPrepartition J) :
    (π.bUnionTagged πi).unionᵢ = ⋃ J ∈ π, (πi J).unionᵢ :=
  union_bUnion _ _
#align box_integral.prepartition.Union_bUnion_tagged BoxIntegral.Prepartition.union_bUnionTagged

theorem forall_bUnionTagged (p : (ι → ℝ) → Box ι → Prop) (π : Prepartition I)
    (πi : ∀ J, TaggedPrepartition J) :
    (∀ J ∈ π.bUnionTagged πi, p ((π.bUnionTagged πi).Tag J) J) ↔
      ∀ J ∈ π, ∀ J' ∈ πi J, p ((πi J).Tag J') J' :=
  by
  simp only [bex_imp, mem_bUnion_tagged]
  refine' ⟨fun H J hJ J' hJ' => _, fun H J' J hJ hJ' => _⟩
  · rw [← π.tag_bUnion_tagged hJ hJ']
    exact H J' J hJ hJ'
  · rw [π.tag_bUnion_tagged hJ hJ']
    exact H J hJ J' hJ'
#align box_integral.prepartition.forall_bUnion_tagged BoxIntegral.Prepartition.forall_bUnionTagged

theorem IsPartition.bUnionTagged {π : Prepartition I} (h : IsPartition π)
    {πi : ∀ J, TaggedPrepartition J} (hi : ∀ J ∈ π, (πi J).IsPartition) :
    (π.bUnionTagged πi).IsPartition :=
  h.bunionᵢ hi
#align box_integral.prepartition.is_partition.bUnion_tagged BoxIntegral.Prepartition.IsPartition.bUnionTagged

end Prepartition

namespace TaggedPrepartition

variable {I J : Box ι} {π π₁ π₂ : TaggedPrepartition I} {x : ι → ℝ}

/-- Given a tagged partition `π` of `I` and a (not tagged) partition `πi J hJ` of each `J ∈ π`,
returns the tagged partition of `I` into all the boxes of all `πi J hJ`. The tag of a box `J`
is defined to be the `π.tag` of the box of the partition `π` that includes `J`.

Note that usually the result is not a Henstock partition. -/
@[simps (config := { fullyApplied := false }) Tag]
def bUnionPrepartition (π : TaggedPrepartition I) (πi : ∀ J, Prepartition J) : TaggedPrepartition I
    where
  toPrepartition := π.toPrepartition.bunionᵢ πi
  Tag J := π.Tag (π.toPrepartition.bUnionIndex πi J)
  tag_mem_icc J := π.tag_mem_icc _
#align box_integral.tagged_prepartition.bUnion_prepartition BoxIntegral.TaggedPrepartition.bUnionPrepartition

theorem IsPartition.bUnionPrepartition {π : TaggedPrepartition I} (h : IsPartition π)
    {πi : ∀ J, Prepartition J} (hi : ∀ J ∈ π, (πi J).IsPartition) :
    (π.bUnionPrepartition πi).IsPartition :=
  h.bunionᵢ hi
#align box_integral.tagged_prepartition.is_partition.bUnion_prepartition BoxIntegral.TaggedPrepartition.IsPartition.bUnionPrepartition

/-- Given two partitions `π₁` and `π₁`, one of them tagged and the other is not, returns the tagged
partition with `to_partition = π₁.to_partition ⊓ π₂` and tags coming from `π₁`.

Note that usually the result is not a Henstock partition. -/
def infPrepartition (π : TaggedPrepartition I) (π' : Prepartition I) : TaggedPrepartition I :=
  π.bUnionPrepartition fun J => π'.restrict J
#align box_integral.tagged_prepartition.inf_prepartition BoxIntegral.TaggedPrepartition.infPrepartition

@[simp]
theorem infPrepartition_toPrepartition (π : TaggedPrepartition I) (π' : Prepartition I) :
    (π.infPrepartition π').toPrepartition = π.toPrepartition ⊓ π' :=
  rfl
#align box_integral.tagged_prepartition.inf_prepartition_to_prepartition BoxIntegral.TaggedPrepartition.infPrepartition_toPrepartition

theorem mem_infPrepartition_comm :
    J ∈ π₁.infPrepartition π₂.toPrepartition ↔ J ∈ π₂.infPrepartition π₁.toPrepartition := by
  simp only [← mem_to_prepartition, inf_prepartition_to_prepartition, inf_comm]
#align box_integral.tagged_prepartition.mem_inf_prepartition_comm BoxIntegral.TaggedPrepartition.mem_infPrepartition_comm

theorem IsPartition.infPrepartition (h₁ : π₁.IsPartition) {π₂ : Prepartition I}
    (h₂ : π₂.IsPartition) : (π₁.infPrepartition π₂).IsPartition :=
  h₁.inf h₂
#align box_integral.tagged_prepartition.is_partition.inf_prepartition BoxIntegral.TaggedPrepartition.IsPartition.infPrepartition

open Metric

/-- A tagged partition is said to be a Henstock partition if for each `J ∈ π`, the tag of `J`
belongs to `J.Icc`. -/
def IsHenstock (π : TaggedPrepartition I) : Prop :=
  ∀ J ∈ π, π.Tag J ∈ J.Icc
#align box_integral.tagged_prepartition.is_Henstock BoxIntegral.TaggedPrepartition.IsHenstock

@[simp]
theorem isHenstock_bUnionTagged {π : Prepartition I} {πi : ∀ J, TaggedPrepartition J} :
    IsHenstock (π.bUnionTagged πi) ↔ ∀ J ∈ π, (πi J).IsHenstock :=
  π.forall_bUnionTagged (fun x J => x ∈ J.Icc) πi
#align box_integral.tagged_prepartition.is_Henstock_bUnion_tagged BoxIntegral.TaggedPrepartition.isHenstock_bUnionTagged

/-- In a Henstock prepartition, there are at most `2 ^ fintype.card ι` boxes with a given tag. -/
theorem IsHenstock.card_filter_tag_eq_le [Fintype ι] (h : π.IsHenstock) (x : ι → ℝ) :
    (π.boxes.filterₓ fun J => π.Tag J = x).card ≤ 2 ^ Fintype.card ι :=
  calc
    (π.boxes.filterₓ fun J => π.Tag J = x).card ≤
        (π.boxes.filterₓ fun J : Box ι => x ∈ J.Icc).card :=
      by
      refine' Finset.card_le_of_subset fun J hJ => _
      rw [Finset.mem_filter] at hJ⊢; rcases hJ with ⟨hJ, rfl⟩
      exact ⟨hJ, h J hJ⟩
    _ ≤ 2 ^ Fintype.card ι := π.toPrepartition.card_filter_mem_icc_le x

#align box_integral.tagged_prepartition.is_Henstock.card_filter_tag_eq_le BoxIntegral.TaggedPrepartition.IsHenstock.card_filter_tag_eq_le

/-- A tagged partition `π` is subordinate to `r : (ι → ℝ) → ℝ` if each box `J ∈ π` is included in
the closed ball with center `π.tag J` and radius `r (π.tag J)`. -/
def IsSubordinate [Fintype ι] (π : TaggedPrepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) : Prop :=
  ∀ J ∈ π, (J : _).Icc ⊆ closedBall (π.Tag J) (r <| π.Tag J)
#align box_integral.tagged_prepartition.is_subordinate BoxIntegral.TaggedPrepartition.IsSubordinate

variable {r r₁ r₂ : (ι → ℝ) → Ioi (0 : ℝ)}

@[simp]
theorem isSubordinate_bUnionTagged [Fintype ι] {π : Prepartition I}
    {πi : ∀ J, TaggedPrepartition J} :
    IsSubordinate (π.bUnionTagged πi) r ↔ ∀ J ∈ π, (πi J).IsSubordinate r :=
  π.forall_bUnionTagged (fun x J => J.Icc ⊆ closedBall x (r x)) πi
#align box_integral.tagged_prepartition.is_subordinate_bUnion_tagged BoxIntegral.TaggedPrepartition.isSubordinate_bUnionTagged

theorem IsSubordinate.bUnionPrepartition [Fintype ι] (h : IsSubordinate π r)
    (πi : ∀ J, Prepartition J) : IsSubordinate (π.bUnionPrepartition πi) r := fun J hJ =>
  Subset.trans (Box.le_iff_icc.1 <| π.toPrepartition.le_bUnionIndex hJ) <|
    h _ <| π.toPrepartition.bUnionIndex_mem hJ
#align box_integral.tagged_prepartition.is_subordinate.bUnion_prepartition BoxIntegral.TaggedPrepartition.IsSubordinate.bUnionPrepartition

theorem IsSubordinate.infPrepartition [Fintype ι] (h : IsSubordinate π r) (π' : Prepartition I) :
    IsSubordinate (π.infPrepartition π') r :=
  h.bUnionPrepartition _
#align box_integral.tagged_prepartition.is_subordinate.inf_prepartition BoxIntegral.TaggedPrepartition.IsSubordinate.infPrepartition

theorem IsSubordinate.mono' [Fintype ι] {π : TaggedPrepartition I} (hr₁ : π.IsSubordinate r₁)
    (h : ∀ J ∈ π, r₁ (π.Tag J) ≤ r₂ (π.Tag J)) : π.IsSubordinate r₂ := fun J hJ x hx =>
  closedBall_subset_closedBall (h _ hJ) (hr₁ _ hJ hx)
#align box_integral.tagged_prepartition.is_subordinate.mono' BoxIntegral.TaggedPrepartition.IsSubordinate.mono'

theorem IsSubordinate.mono [Fintype ι] {π : TaggedPrepartition I} (hr₁ : π.IsSubordinate r₁)
    (h : ∀ x ∈ I.Icc, r₁ x ≤ r₂ x) : π.IsSubordinate r₂ :=
  hr₁.mono' fun J _ => h _ <| π.tag_mem_icc J
#align box_integral.tagged_prepartition.is_subordinate.mono BoxIntegral.TaggedPrepartition.IsSubordinate.mono

theorem IsSubordinate.diam_le [Fintype ι] {π : TaggedPrepartition I} (h : π.IsSubordinate r)
    (hJ : J ∈ π.boxes) : diam J.Icc ≤ 2 * r (π.Tag J) :=
  calc
    diam J.Icc ≤ diam (closedBall (π.Tag J) (r <| π.Tag J)) := diam_mono (h J hJ) bounded_closedBall
    _ ≤ 2 * r (π.Tag J) := diam_closedBall (le_of_lt (r _).2)

#align box_integral.tagged_prepartition.is_subordinate.diam_le BoxIntegral.TaggedPrepartition.IsSubordinate.diam_le

/-- Tagged prepartition with single box and prescribed tag. -/
@[simps (config := { fullyApplied := false })]
def single (I J : Box ι) (hJ : J ≤ I) (x : ι → ℝ) (h : x ∈ I.Icc) : TaggedPrepartition I :=
  ⟨Prepartition.single I J hJ, fun J => x, fun J => h⟩
#align box_integral.tagged_prepartition.single BoxIntegral.TaggedPrepartition.single

@[simp]
theorem mem_single {J'} (hJ : J ≤ I) (h : x ∈ I.Icc) : J' ∈ single I J hJ x h ↔ J' = J :=
  Finset.mem_singleton
#align box_integral.tagged_prepartition.mem_single BoxIntegral.TaggedPrepartition.mem_single

instance (I : Box ι) : Inhabited (TaggedPrepartition I) :=
  ⟨single I I le_rfl I.upper I.upper_mem_icc⟩

theorem isPartition_single_iff (hJ : J ≤ I) (h : x ∈ I.Icc) :
    (single I J hJ x h).IsPartition ↔ J = I :=
  Prepartition.isPartition_single_iff hJ
#align box_integral.tagged_prepartition.is_partition_single_iff BoxIntegral.TaggedPrepartition.isPartition_single_iff

theorem isPartitionSingle (h : x ∈ I.Icc) : (single I I le_rfl x h).IsPartition :=
  Prepartition.isPartitionTop I
#align box_integral.tagged_prepartition.is_partition_single BoxIntegral.TaggedPrepartition.isPartitionSingle

theorem forall_mem_single (p : (ι → ℝ) → Box ι → Prop) (hJ : J ≤ I) (h : x ∈ I.Icc) :
    (∀ J' ∈ single I J hJ x h, p ((single I J hJ x h).Tag J') J') ↔ p x J := by simp
#align box_integral.tagged_prepartition.forall_mem_single BoxIntegral.TaggedPrepartition.forall_mem_single

@[simp]
theorem isHenstock_single_iff (hJ : J ≤ I) (h : x ∈ I.Icc) :
    IsHenstock (single I J hJ x h) ↔ x ∈ J.Icc :=
  forall_mem_single (fun x J => x ∈ J.Icc) hJ h
#align box_integral.tagged_prepartition.is_Henstock_single_iff BoxIntegral.TaggedPrepartition.isHenstock_single_iff

@[simp]
theorem isHenstockSingle (h : x ∈ I.Icc) : IsHenstock (single I I le_rfl x h) :=
  (isHenstock_single_iff (le_refl I) h).2 h
#align box_integral.tagged_prepartition.is_Henstock_single BoxIntegral.TaggedPrepartition.isHenstockSingle

@[simp]
theorem isSubordinate_single [Fintype ι] (hJ : J ≤ I) (h : x ∈ I.Icc) :
    IsSubordinate (single I J hJ x h) r ↔ J.Icc ⊆ closedBall x (r x) :=
  forall_mem_single (fun x J => J.Icc ⊆ closedBall x (r x)) hJ h
#align box_integral.tagged_prepartition.is_subordinate_single BoxIntegral.TaggedPrepartition.isSubordinate_single

@[simp]
theorem union_single (hJ : J ≤ I) (h : x ∈ I.Icc) : (single I J hJ x h).unionᵢ = J :=
  Prepartition.union_single hJ
#align box_integral.tagged_prepartition.Union_single BoxIntegral.TaggedPrepartition.union_single

/-- Union of two tagged prepartitions with disjoint unions of boxes. -/
def disjUnion (π₁ π₂ : TaggedPrepartition I) (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    TaggedPrepartition I
    where
  toPrepartition := π₁.toPrepartition.disjUnion π₂.toPrepartition h
  Tag := π₁.boxes.piecewise π₁.Tag π₂.Tag
  tag_mem_icc J := by
    dsimp only [Finset.piecewise]
    split_ifs
    exacts[π₁.tag_mem_Icc J, π₂.tag_mem_Icc J]
#align box_integral.tagged_prepartition.disj_union BoxIntegral.TaggedPrepartition.disjUnion

@[simp]
theorem disjUnion_boxes (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    (π₁.disjUnion π₂ h).boxes = π₁.boxes ∪ π₂.boxes :=
  rfl
#align box_integral.tagged_prepartition.disj_union_boxes BoxIntegral.TaggedPrepartition.disjUnion_boxes

@[simp]
theorem mem_disjUnion (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    J ∈ π₁.disjUnion π₂ h ↔ J ∈ π₁ ∨ J ∈ π₂ :=
  Finset.mem_union
#align box_integral.tagged_prepartition.mem_disj_union BoxIntegral.TaggedPrepartition.mem_disjUnion

@[simp]
theorem union_disjUnion (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    (π₁.disjUnion π₂ h).unionᵢ = π₁.unionᵢ ∪ π₂.unionᵢ :=
  Prepartition.union_disjUnion _
#align box_integral.tagged_prepartition.Union_disj_union BoxIntegral.TaggedPrepartition.union_disjUnion

theorem disjUnion_tag_of_mem_left (h : Disjoint π₁.unionᵢ π₂.unionᵢ) (hJ : J ∈ π₁) :
    (π₁.disjUnion π₂ h).Tag J = π₁.Tag J :=
  dif_pos hJ
#align box_integral.tagged_prepartition.disj_union_tag_of_mem_left BoxIntegral.TaggedPrepartition.disjUnion_tag_of_mem_left

theorem disjUnion_tag_of_mem_right (h : Disjoint π₁.unionᵢ π₂.unionᵢ) (hJ : J ∈ π₂) :
    (π₁.disjUnion π₂ h).Tag J = π₂.Tag J :=
  dif_neg fun h₁ => h.le_bot ⟨π₁.subset_unionᵢ h₁ J.upper_mem, π₂.subset_unionᵢ hJ J.upper_mem⟩
#align box_integral.tagged_prepartition.disj_union_tag_of_mem_right BoxIntegral.TaggedPrepartition.disjUnion_tag_of_mem_right

theorem IsSubordinate.disjUnion [Fintype ι] (h₁ : IsSubordinate π₁ r) (h₂ : IsSubordinate π₂ r)
    (h : Disjoint π₁.unionᵢ π₂.unionᵢ) : IsSubordinate (π₁.disjUnion π₂ h) r :=
  by
  refine' fun J hJ => (Finset.mem_union.1 hJ).elim (fun hJ => _) fun hJ => _
  · rw [disj_union_tag_of_mem_left _ hJ]
    exact h₁ _ hJ
  · rw [disj_union_tag_of_mem_right _ hJ]
    exact h₂ _ hJ
#align box_integral.tagged_prepartition.is_subordinate.disj_union BoxIntegral.TaggedPrepartition.IsSubordinate.disjUnion

theorem IsHenstock.disjUnion (h₁ : IsHenstock π₁) (h₂ : IsHenstock π₂)
    (h : Disjoint π₁.unionᵢ π₂.unionᵢ) : IsHenstock (π₁.disjUnion π₂ h) :=
  by
  refine' fun J hJ => (Finset.mem_union.1 hJ).elim (fun hJ => _) fun hJ => _
  · rw [disj_union_tag_of_mem_left _ hJ]
    exact h₁ _ hJ
  · rw [disj_union_tag_of_mem_right _ hJ]
    exact h₂ _ hJ
#align box_integral.tagged_prepartition.is_Henstock.disj_union BoxIntegral.TaggedPrepartition.IsHenstock.disjUnion

/-- If `I ≤ J`, then every tagged prepartition of `I` is a tagged prepartition of `J`. -/
def embedBox (I J : Box ι) (h : I ≤ J) : TaggedPrepartition I ↪ TaggedPrepartition J
    where
  toFun π :=
    { π with
      le_of_mem' := fun J' hJ' => (π.le_of_mem' J' hJ').trans h
      tag_mem_icc := fun J => Box.le_iff_icc.1 h (π.tag_mem_icc J) }
  inj' := by
    rintro ⟨⟨b₁, h₁le, h₁d⟩, t₁, ht₁⟩ ⟨⟨b₂, h₂le, h₂d⟩, t₂, ht₂⟩ H
    simpa using H
#align box_integral.tagged_prepartition.embed_box BoxIntegral.TaggedPrepartition.embedBox

section Distortion

variable [Fintype ι] (π)

open Finset

/-- The distortion of a tagged prepartition is the maximum of distortions of its boxes. -/
def distortion : ℝ≥0 :=
  π.toPrepartition.distortion
#align box_integral.tagged_prepartition.distortion BoxIntegral.TaggedPrepartition.distortion

theorem distortion_le_of_mem (h : J ∈ π) : J.distortion ≤ π.distortion :=
  le_sup h
#align box_integral.tagged_prepartition.distortion_le_of_mem BoxIntegral.TaggedPrepartition.distortion_le_of_mem

theorem distortion_le_iff {c : ℝ≥0} : π.distortion ≤ c ↔ ∀ J ∈ π, Box.distortion J ≤ c :=
  Finset.sup_le_iff
#align box_integral.tagged_prepartition.distortion_le_iff BoxIntegral.TaggedPrepartition.distortion_le_iff

@[simp]
theorem BoxIntegral.Prepartition.distortion_bUnionTagged (π : Prepartition I)
    (πi : ∀ J, TaggedPrepartition J) :
    (π.bUnionTagged πi).distortion = π.boxes.sup fun J => (πi J).distortion :=
  sup_bunionᵢ _ _
#align box_integral.prepartition.distortion_bUnion_tagged BoxIntegral.Prepartition.distortion_bUnionTagged

@[simp]
theorem distortion_bUnionPrepartition (π : TaggedPrepartition I) (πi : ∀ J, Prepartition J) :
    (π.bUnionPrepartition πi).distortion = π.boxes.sup fun J => (πi J).distortion :=
  sup_bunionᵢ _ _
#align box_integral.tagged_prepartition.distortion_bUnion_prepartition BoxIntegral.TaggedPrepartition.distortion_bUnionPrepartition

@[simp]
theorem distortion_disjUnion (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    (π₁.disjUnion π₂ h).distortion = max π₁.distortion π₂.distortion :=
  sup_union
#align box_integral.tagged_prepartition.distortion_disj_union BoxIntegral.TaggedPrepartition.distortion_disjUnion

theorem distortion_of_const {c} (h₁ : π.boxes.Nonempty) (h₂ : ∀ J ∈ π, Box.distortion J = c) :
    π.distortion = c :=
  (sup_congr rfl h₂).trans (sup_const h₁ _)
#align box_integral.tagged_prepartition.distortion_of_const BoxIntegral.TaggedPrepartition.distortion_of_const

@[simp]
theorem distortion_single (hJ : J ≤ I) (h : x ∈ I.Icc) :
    distortion (single I J hJ x h) = J.distortion :=
  sup_singleton
#align box_integral.tagged_prepartition.distortion_single BoxIntegral.TaggedPrepartition.distortion_single

theorem distortion_filter_le (p : Box ι → Prop) : (π.filterₓ p).distortion ≤ π.distortion :=
  sup_mono (filter_subset _ _)
#align box_integral.tagged_prepartition.distortion_filter_le BoxIntegral.TaggedPrepartition.distortion_filter_le

end Distortion

end TaggedPrepartition

end BoxIntegral


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

! This file was ported from Lean 3 source module category_theory.opposites
! leanprover-community/mathlib commit dde670c9a3f503647fd5bfdf1037bad526d3397a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Equivalence

/-!
# Opposite categories

We provide a category instance on `Cᵒᵖ`.
The morphisms `X ⟶ Y` are defined to be the morphisms `unop Y ⟶ unop X` in `C`.

Here `Cᵒᵖ` is an irreducible typeclass synonym for `C`
(it is the same one used in the algebra library).

We also provide various mechanisms for constructing opposite morphisms, functors,
and natural transformations.

Unfortunately, because we do not have a definitional equality `op (op X) = X`,
there are quite a few variations that are needed in practice.
-/

set_option autoImplicit false

universe v₁ v₂ u₁ u₂

-- morphism levels before object levels. See note [CategoryTheory universes].
open Opposite

variable {C : Type u₁}

section Quiver

variable [Quiver.{v₁} C]

theorem Quiver.Hom.op_inj {X Y : C} :
    Function.Injective (Quiver.Hom.op : (X ⟶ Y) → (Opposite.op Y ⟶ Opposite.op X)) := fun _ _ H =>
  congr_arg Quiver.Hom.unop H
#align quiver.hom.op_inj Quiver.Hom.op_inj

theorem Quiver.Hom.unop_inj {X Y : Cᵒᵖ} :
    Function.Injective (Quiver.Hom.unop : (X ⟶ Y) → (Opposite.unop Y ⟶ Opposite.unop X)) :=
    fun _ _ H =>
  congr_arg Quiver.Hom.op H
#align quiver.hom.unop_inj Quiver.Hom.unop_inj

@[simp]
theorem Quiver.Hom.unop_op {X Y : C} (f : X ⟶ Y) : f.op.unop = f :=
  rfl
#align quiver.hom.unop_op Quiver.Hom.unop_op

@[simp]
theorem Quiver.Hom.op_unop {X Y : Cᵒᵖ} (f : X ⟶ Y) : f.unop.op = f :=
  rfl
#align quiver.hom.op_unop Quiver.Hom.op_unop

end Quiver

namespace CategoryTheory

variable [Category.{v₁} C]

/-- The opposite category.

See <https://stacks.math.columbia.edu/tag/001M>.
-/
instance Category.opposite : Category.{v₁} Cᵒᵖ
    where
  comp := @fun _ _ _ f g => (g.unop ≫ f.unop).op
  id X := (𝟙 (unop X)).op
#align category_theory.category.opposite CategoryTheory.Category.opposite

@[simp]
theorem op_comp {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} : (f ≫ g).op = g.op ≫ f.op :=
  rfl
#align category_theory.op_comp CategoryTheory.op_comp

@[simp]
theorem op_id {X : C} : (𝟙 X).op = 𝟙 (op X) :=
  rfl
#align category_theory.op_id CategoryTheory.op_id

@[simp]
theorem unop_comp {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : Y ⟶ Z} : (f ≫ g).unop = g.unop ≫ f.unop :=
  rfl
#align category_theory.unop_comp CategoryTheory.unop_comp

@[simp]
theorem unop_id {X : Cᵒᵖ} : (𝟙 X).unop = 𝟙 (unop X) :=
  rfl
#align category_theory.unop_id CategoryTheory.unop_id

@[simp]
theorem unop_id_op {X : C} : (𝟙 (op X)).unop = 𝟙 X :=
  rfl
#align category_theory.unop_id_op CategoryTheory.unop_id_op

@[simp]
theorem op_id_unop {X : Cᵒᵖ} : (𝟙 (unop X)).op = 𝟙 X :=
  rfl
#align category_theory.op_id_unop CategoryTheory.op_id_unop

section

variable (C)

/-- The functor from the double-opposite of a category to the underlying category. -/
@[simps]
def opOp : Cᵒᵖᵒᵖ ⥤ C where
  obj X := unop (unop X)
  map := @fun X Y f => f.unop.unop
#align category_theory.op_op CategoryTheory.opOp

/-- The functor from a category to its double-opposite.  -/
@[simps]
def unopUnop : C ⥤ Cᵒᵖᵒᵖ where
  obj X := op (op X)
  map := @fun X Y f => f.op.op
#align category_theory.unop_unop CategoryTheory.unopUnop

/-- The double opposite category is equivalent to the original. -/
@[simps]
def opOpEquivalence : Cᵒᵖᵒᵖ ≌ C where
  functor := opOp C
  inverse := unopUnop C
  unitIso := Iso.refl (𝟭 Cᵒᵖᵒᵖ)
  counitIso := Iso.refl (unopUnop C ⋙ opOp C)
#align category_theory.op_op_equivalence CategoryTheory.opOpEquivalence

end

/-- If `f` is an isomorphism, so is `f.op` -/
instance isIso_op {X Y : C} (f : X ⟶ Y) [IsIso f] : IsIso f.op :=
  ⟨⟨(inv f).op, ⟨Quiver.Hom.unop_inj (by aesop_cat), Quiver.Hom.unop_inj (by aesop_cat)⟩⟩⟩
#align category_theory.is_iso_op CategoryTheory.isIso_op

/-- If `f.op` is an isomorphism `f` must be too.
(This cannot be an instance as it would immediately loop!)
-/
theorem isIso_of_op {X Y : C} (f : X ⟶ Y) [IsIso f.op] : IsIso f :=
  ⟨⟨(inv f.op).unop, ⟨Quiver.Hom.op_inj (by simp), Quiver.Hom.op_inj (by simp)⟩⟩⟩
#align category_theory.is_iso_of_op CategoryTheory.isIso_of_op

theorem isIso_op_iff {X Y : C} (f : X ⟶ Y) : IsIso f.op ↔ IsIso f :=
  ⟨fun _ => isIso_of_op _, fun _ => inferInstance⟩
#align category_theory.is_iso_op_iff CategoryTheory.isIso_op_iff

theorem isIso_unop_iff {X Y : Cᵒᵖ} (f : X ⟶ Y) : IsIso f.unop ↔ IsIso f := by
  rw [← isIso_op_iff f.unop, Quiver.Hom.op_unop]
#align category_theory.is_iso_unop_iff CategoryTheory.isIso_unop_iff

instance isIso_unop {X Y : Cᵒᵖ} (f : X ⟶ Y) [IsIso f] : IsIso f.unop :=
  (isIso_unop_iff _).2 inferInstance
#align category_theory.is_iso_unop CategoryTheory.isIso_unop

@[simp]
theorem op_inv {X Y : C} (f : X ⟶ Y) [IsIso f] : (inv f).op = inv f.op := by
  aesop_cat_nonterminal
  rw [← op_comp, IsIso.inv_hom_id, op_id]
#align category_theory.op_inv CategoryTheory.op_inv

@[simp]
theorem unop_inv {X Y : Cᵒᵖ} (f : X ⟶ Y) [IsIso f] : (inv f).unop = inv f.unop := by
  aesop_cat_nonterminal
  rw [← unop_comp, IsIso.inv_hom_id, unop_id]
#align category_theory.unop_inv CategoryTheory.unop_inv

namespace Functor

section

variable {D : Type u₂} [Category.{v₂} D]

-- porting note: commenting out redundant binder annotation update
-- variable {C D}

/-- The opposite of a functor, i.e. considering a functor `F : C ⥤ D` as a functor `Cᵒᵖ ⥤ Dᵒᵖ`.
In informal mathematics no distinction is made between these.
-/
@[simps]
protected def op (F : C ⥤ D) : Cᵒᵖ ⥤ Dᵒᵖ
    where
  obj X := op (F.obj (unop X))
  map := @fun X Y f => (F.map f.unop).op
#align category_theory.functor.op CategoryTheory.Functor.op

/-- Given a functor `F : Cᵒᵖ ⥤ Dᵒᵖ` we can take the "unopposite" functor `F : C ⥤ D`.
In informal mathematics no distinction is made between these.
-/
@[simps]
protected def unop (F : Cᵒᵖ ⥤ Dᵒᵖ) : C ⥤ D
    where
  obj X := unop (F.obj (op X))
  map := @fun X Y f => (F.map f.op).unop
#align category_theory.functor.unop CategoryTheory.Functor.unop

/-- The isomorphism between `F.op.unop` and `F`. -/
@[simps!]
def opUnopIso (F : C ⥤ D) : F.op.unop ≅ F :=
  NatIso.ofComponents (fun X => Iso.refl _) (by aesop_cat)
#align category_theory.functor.op_unop_iso CategoryTheory.Functor.opUnopIso

/-- The isomorphism between `F.unop.op` and `F`. -/
@[simps!]
def unopOpIso (F : Cᵒᵖ ⥤ Dᵒᵖ) : F.unop.op ≅ F :=
  NatIso.ofComponents (fun X => Iso.refl _) (by aesop_cat)
#align category_theory.functor.unop_op_iso CategoryTheory.Functor.unopOpIso

variable (C D)

/-- Taking the opposite of a functor is functorial.
-/
@[simps]
def opHom : (C ⥤ D)ᵒᵖ ⥤ Cᵒᵖ ⥤ Dᵒᵖ where
  obj F := (unop F).op
  map := @fun F G α =>
    { app := fun X => (α.unop.app (unop X)).op
      naturality := fun X Y f => Quiver.Hom.unop_inj (α.unop.naturality f.unop).symm }
#align category_theory.functor.op_hom CategoryTheory.Functor.opHom

/-- Take the "unopposite" of a functor is functorial.
-/
@[simps]
def opInv : (Cᵒᵖ ⥤ Dᵒᵖ) ⥤ (C ⥤ D)ᵒᵖ where
  obj F := op F.unop
  map := @fun F G α =>
    Quiver.Hom.op
      { app := fun X => (α.app (op X)).unop
        naturality := fun X Y f => Quiver.Hom.op_inj <| (α.naturality f.op).symm }
#align category_theory.functor.op_inv CategoryTheory.Functor.opInv

variable {C D}

/--
Another variant of the opposite of functor, turning a functor `C ⥤ Dᵒᵖ` into a functor `Cᵒᵖ ⥤ D`.
In informal mathematics no distinction is made.
-/
@[simps]
protected def leftOp (F : C ⥤ Dᵒᵖ) : Cᵒᵖ ⥤ D
    where
  obj X := unop (F.obj (unop X))
  map := @fun X Y f => (F.map f.unop).unop
#align category_theory.functor.left_op CategoryTheory.Functor.leftOp

/--
Another variant of the opposite of functor, turning a functor `Cᵒᵖ ⥤ D` into a functor `C ⥤ Dᵒᵖ`.
In informal mathematics no distinction is made.
-/
@[simps]
protected def rightOp (F : Cᵒᵖ ⥤ D) : C ⥤ Dᵒᵖ
    where
  obj X := op (F.obj (op X))
  map := @fun X Y f => (F.map f.op).op
#align category_theory.functor.right_op CategoryTheory.Functor.rightOp

instance {F : C ⥤ D} [Full F] : Full F.op where preimage := @fun X Y f => (F.preimage f.unop).op

instance {F : C ⥤ D} [Faithful F] : Faithful F.op
    where map_injective := @fun X Y f g h =>
    Quiver.Hom.unop_inj <| by simpa using map_injective F (Quiver.Hom.op_inj h)

/-- If F is faithful then the right_op of F is also faithful. -/
instance rightOp_faithful {F : Cᵒᵖ ⥤ D} [Faithful F] : Faithful F.rightOp
    where map_injective := @fun _ _ _ _ h =>
        Quiver.Hom.op_inj (map_injective F (Quiver.Hom.op_inj h))
#align category_theory.functor.right_op_faithful CategoryTheory.Functor.rightOp_faithful

/-- If F is faithful then the left_op of F is also faithful. -/
instance leftOp_faithful {F : C ⥤ Dᵒᵖ} [Faithful F] : Faithful F.leftOp
    where map_injective := @fun _ _ _ _ h =>
        Quiver.Hom.unop_inj (map_injective F (Quiver.Hom.unop_inj h))
#align category_theory.functor.left_op_faithful CategoryTheory.Functor.leftOp_faithful

/-- The isomorphism between `F.leftOp.rightOp` and `F`. -/
@[simps!]
def leftOpRightOpIso (F : C ⥤ Dᵒᵖ) : F.leftOp.rightOp ≅ F :=
  NatIso.ofComponents (fun X => Iso.refl _) (by aesop_cat)
#align category_theory.functor.left_op_right_op_iso CategoryTheory.Functor.leftOpRightOpIso

/-- The isomorphism between `F.rightOp.leftOp` and `F`. -/
@[simps!]
def rightOpLeftOpIso (F : Cᵒᵖ ⥤ D) : F.rightOp.leftOp ≅ F :=
  NatIso.ofComponents (fun X => Iso.refl _) (by aesop_cat)
#align category_theory.functor.right_op_left_op_iso CategoryTheory.Functor.rightOpLeftOpIso

/-- Whenever possible, it is advisable to use the isomorphism `rightOpLeftOpIso`
instead of this equality of functors. -/
theorem rightOp_leftOp_eq (F : Cᵒᵖ ⥤ D) : F.rightOp.leftOp = F := by
  cases F
  rfl
#align category_theory.functor.right_op_left_op_eq CategoryTheory.Functor.rightOp_leftOp_eq

end

end Functor

namespace NatTrans

variable {D : Type u₂} [Category.{v₂} D]

section

variable {F G : C ⥤ D}

/-- The opposite of a natural transformation. -/
@[simps]
protected def op (α : F ⟶ G) : G.op ⟶ F.op
    where
  app X := (α.app (unop X)).op
  naturality X Y f := Quiver.Hom.unop_inj (by simp)
#align category_theory.nat_trans.op CategoryTheory.NatTrans.op

@[simp]
theorem op_id (F : C ⥤ D) : NatTrans.op (𝟙 F) = 𝟙 F.op :=
  rfl
#align category_theory.nat_trans.op_id CategoryTheory.NatTrans.op_id

/-- The "unopposite" of a natural transformation. -/
@[simps]
protected def unop {F G : Cᵒᵖ ⥤ Dᵒᵖ} (α : F ⟶ G) : G.unop ⟶ F.unop
    where
  app X := (α.app (op X)).unop
  naturality X Y f := Quiver.Hom.op_inj (by simp)
#align category_theory.nat_trans.unop CategoryTheory.NatTrans.unop

@[simp]
theorem unop_id (F : Cᵒᵖ ⥤ Dᵒᵖ) : NatTrans.unop (𝟙 F) = 𝟙 F.unop :=
  rfl
#align category_theory.nat_trans.unop_id CategoryTheory.NatTrans.unop_id

/-- Given a natural transformation `α : F.op ⟶ G.op`,
we can take the "unopposite" of each component obtaining a natural transformation `G ⟶ F`.
-/
@[simps]
protected def removeOp (α : F.op ⟶ G.op) : G ⟶ F
    where
  app X := (α.app (op X)).unop
  naturality X Y f :=
    Quiver.Hom.op_inj <| by simpa only [Functor.op_map] using (α.naturality f.op).symm
#align category_theory.nat_trans.remove_op CategoryTheory.NatTrans.removeOp

@[simp]
theorem removeOp_id (F : C ⥤ D) : NatTrans.removeOp (𝟙 F.op) = 𝟙 F :=
  rfl
#align category_theory.nat_trans.remove_op_id CategoryTheory.NatTrans.removeOp_id

/-- Given a natural transformation `α : F.unop ⟶ G.unop`, we can take the opposite of each
component obtaining a natural transformation `G ⟶ F`. -/
@[simps]
protected def removeUnop {F G : Cᵒᵖ ⥤ Dᵒᵖ} (α : F.unop ⟶ G.unop) : G ⟶ F
    where
  app X := (α.app (unop X)).op
  naturality X Y f :=
    Quiver.Hom.unop_inj <| by simpa only [Functor.unop_map] using (α.naturality f.unop).symm
#align category_theory.nat_trans.remove_unop CategoryTheory.NatTrans.removeUnop

@[simp]
theorem removeUnop_id (F : Cᵒᵖ ⥤ Dᵒᵖ) : NatTrans.removeUnop (𝟙 F.unop) = 𝟙 F :=
  rfl
#align category_theory.nat_trans.remove_unop_id CategoryTheory.NatTrans.removeUnop_id

end

section

variable {F G H : C ⥤ Dᵒᵖ}

/-- Given a natural transformation `α : F ⟶ G`, for `F G : C ⥤ Dᵒᵖ`,
taking `unop` of each component gives a natural transformation `G.left_op ⟶ F.left_op`.
-/
@[simps]
protected def leftOp (α : F ⟶ G) : G.leftOp ⟶ F.leftOp
    where
  app X := (α.app (unop X)).unop
  naturality X Y f := Quiver.Hom.op_inj (by simp)
#align category_theory.nat_trans.left_op CategoryTheory.NatTrans.leftOp

@[simp]
theorem leftOp_id : NatTrans.leftOp (𝟙 F : F ⟶ F) = 𝟙 F.leftOp :=
  rfl
#align category_theory.nat_trans.left_op_id CategoryTheory.NatTrans.leftOp_id

@[simp]
theorem leftOp_comp (α : F ⟶ G) (β : G ⟶ H) : NatTrans.leftOp (α ≫ β) =
    NatTrans.leftOp β ≫ NatTrans.leftOp α :=
  rfl
#align category_theory.nat_trans.left_op_comp CategoryTheory.NatTrans.leftOp_comp

/-- Given a natural transformation `α : F.leftOp ⟶ G.leftOp`, for `F G : C ⥤ Dᵒᵖ`,
taking `op` of each component gives a natural transformation `G ⟶ F`.
-/
@[simps]
protected def removeLeftOp (α : F.leftOp ⟶ G.leftOp) : G ⟶ F
    where
  app X := (α.app (op X)).op
  naturality X Y f :=
    Quiver.Hom.unop_inj <| by simpa only [Functor.leftOp_map] using (α.naturality f.op).symm
#align category_theory.nat_trans.remove_left_op CategoryTheory.NatTrans.removeLeftOp

@[simp]

end

section

variable {F G H : Cᵒᵖ ⥤ D}

/-- Given a natural transformation `α : F ⟶ G`, for `F G : Cᵒᵖ ⥤ D`,
taking `op` of each component gives a natural transformation `G.rightOp ⟶ F.rightOp`.
-/
@[simps]
protected def rightOp (α : F ⟶ G) : G.rightOp ⟶ F.rightOp
    where
  app X := (α.app _).op
  naturality X Y f := Quiver.Hom.unop_inj (by simp)
#align category_theory.nat_trans.right_op CategoryTheory.NatTrans.rightOp

@[simp]
theorem rightOp_id : NatTrans.rightOp (𝟙 F : F ⟶ F) = 𝟙 F.rightOp :=
  rfl
#align category_theory.nat_trans.right_op_id CategoryTheory.NatTrans.rightOp_id

@[simp]
theorem rightOp_comp (α : F ⟶ G) (β : G ⟶ H) : NatTrans.rightOp (α ≫ β) =
    NatTrans.rightOp β ≫ NatTrans.rightOp α :=
  rfl
#align category_theory.nat_trans.right_op_comp CategoryTheory.NatTrans.rightOp_comp

/-- Given a natural transformation `α : F.rightOp ⟶ G.rightOp`, for `F G : Cᵒᵖ ⥤ D`,
taking `unop` of each component gives a natural transformation `G ⟶ F`.
-/
@[simps]
protected def removeRightOp (α : F.rightOp ⟶ G.rightOp) : G ⟶ F
    where
  app X := (α.app X.unop).unop
  naturality X Y f :=
    Quiver.Hom.op_inj <| by simpa only [Functor.rightOp_map] using (α.naturality f.unop).symm
#align category_theory.nat_trans.remove_right_op CategoryTheory.NatTrans.removeRightOp

@[simp]
theorem removeRightOp_id : NatTrans.removeRightOp (𝟙 F.rightOp) = 𝟙 F :=
  rfl
#align category_theory.nat_trans.remove_right_op_id CategoryTheory.NatTrans.removeRightOp_id

end

end NatTrans

namespace Iso

variable {X Y : C}

/-- The opposite isomorphism.
-/
@[simps]
protected def op (α : X ≅ Y) : op Y ≅ op X
    where
  hom := α.hom.op
  inv := α.inv.op
  hom_inv_id := Quiver.Hom.unop_inj α.inv_hom_id
  inv_hom_id := Quiver.Hom.unop_inj α.hom_inv_id
#align category_theory.iso.op CategoryTheory.Iso.op

/-- The isomorphism obtained from an isomorphism in the opposite category. -/
@[simps]
def unop {X Y : Cᵒᵖ} (f : X ≅ Y) : Y.unop ≅ X.unop
    where
  hom := f.hom.unop
  inv := f.inv.unop
  hom_inv_id := by simp only [← unop_comp, f.inv_hom_id, unop_id]
  inv_hom_id := by simp only [← unop_comp, f.hom_inv_id, unop_id]
#align category_theory.iso.unop CategoryTheory.Iso.unop

@[simp]
theorem unop_op {X Y : Cᵒᵖ} (f : X ≅ Y) : f.unop.op = f := by (ext; rfl)
#align category_theory.iso.unop_op CategoryTheory.Iso.unop_op

@[simp]
theorem op_unop {X Y : C} (f : X ≅ Y) : f.op.unop = f := by (ext; rfl)
#align category_theory.iso.op_unop CategoryTheory.Iso.op_unop

end Iso

namespace NatIso

variable {D : Type u₂} [Category.{v₂} D]

variable {F G : C ⥤ D}

/-- The natural isomorphism between opposite functors `G.op ≅ F.op` induced by a natural
isomorphism between the original functors `F ≅ G`. -/
@[simps]
protected def op (α : F ≅ G) : G.op ≅ F.op
    where
  hom := NatTrans.op α.hom
  inv := NatTrans.op α.inv
  hom_inv_id := by ext; dsimp; rw [← op_comp]; rw [α.inv_hom_id_app]; rfl
  inv_hom_id := by ext; dsimp; rw [← op_comp]; rw [α.hom_inv_id_app]; rfl
#align category_theory.nat_iso.op CategoryTheory.NatIso.op

/-- The natural isomorphism between functors `G ≅ F` induced by a natural isomorphism
between the opposite functors `F.op ≅ G.op`. -/
@[simps]
protected def removeOp (α : F.op ≅ G.op) : G ≅ F
    where
  hom := NatTrans.removeOp α.hom
  inv := NatTrans.removeOp α.inv
  hom_inv_id := by ext; dsimp; rw [← unop_comp]; rw [α.inv_hom_id_app]; rfl
  inv_hom_id := by ext; dsimp; rw [← unop_comp]; rw [α.hom_inv_id_app]; rfl
#align category_theory.nat_iso.remove_op CategoryTheory.NatIso.removeOp

/-- The natural isomorphism between functors `G.unop ≅ F.unop` induced by a natural isomorphism
between the original functors `F ≅ G`. -/
@[simps]
protected def unop {F G : Cᵒᵖ ⥤ Dᵒᵖ} (α : F ≅ G) : G.unop ≅ F.unop
    where
  hom := NatTrans.unop α.hom
  inv := NatTrans.unop α.inv
  hom_inv_id := by ext; dsimp; rw [← unop_comp]; rw [α.inv_hom_id_app]; rfl
  inv_hom_id := by ext; dsimp; rw [← unop_comp]; rw [α.hom_inv_id_app]; rfl
#align category_theory.nat_iso.unop CategoryTheory.NatIso.unop

end NatIso

namespace Equivalence

variable {D : Type u₂} [Category.{v₂} D]

/-- An equivalence between categories gives an equivalence between the opposite categories.
-/
@[simps]
def op (e : C ≌ D) : Cᵒᵖ ≌ Dᵒᵖ where
  functor := e.functor.op
  inverse := e.inverse.op
  unitIso := (NatIso.op e.unitIso).symm
  counitIso := (NatIso.op e.counitIso).symm
  functor_unitIso_comp X := by
    apply Quiver.Hom.unop_inj
    dsimp
    simp
#align category_theory.equivalence.op CategoryTheory.Equivalence.op

/-- An equivalence between opposite categories gives an equivalence between the original categories.
-/
@[simps]
def unop (e : Cᵒᵖ ≌ Dᵒᵖ) : C ≌ D where
  functor := e.functor.unop
  inverse := e.inverse.unop
  unitIso := (NatIso.unop e.unitIso).symm
  counitIso := (NatIso.unop e.counitIso).symm
  functor_unitIso_comp X := by
    apply Quiver.Hom.op_inj
    dsimp
    simp
#align category_theory.equivalence.unop CategoryTheory.Equivalence.unop

end Equivalence

/-- The equivalence between arrows of the form `A ⟶ B` and `B.unop ⟶ A.unop`. Useful for building
adjunctions.
Note that this (definitionally) gives variants
```
def opEquiv' (A : C) (B : Cᵒᵖ) : (opposite.op A ⟶ B) ≃ (B.unop ⟶ A) :=
opEquiv _ _

def opEquiv'' (A : Cᵒᵖ) (B : C) : (A ⟶ opposite.op B) ≃ (B ⟶ A.unop) :=
opEquiv _ _

def opEquiv''' (A B : C) : (opposite.op A ⟶ opposite.op B) ≃ (B ⟶ A) :=
opEquiv _ _
```
-/
@[simps]
def opEquiv (A B : Cᵒᵖ) : (A ⟶ B) ≃ (B.unop ⟶ A.unop)
    where
  toFun f := f.unop
  invFun g := g.op
  left_inv _ := rfl
  right_inv _ := rfl
#align category_theory.op_equiv CategoryTheory.opEquiv

instance subsingleton_of_unop (A B : Cᵒᵖ) [Subsingleton (unop B ⟶ unop A)] : Subsingleton (A ⟶ B) :=
  (opEquiv A B).subsingleton
#align category_theory.subsingleton_of_unop CategoryTheory.subsingleton_of_unop

instance decidableEqOfUnop (A B : Cᵒᵖ) [DecidableEq (unop B ⟶ unop A)] : DecidableEq (A ⟶ B) :=
  (opEquiv A B).decidableEq
#align category_theory.decidable_eq_of_unop CategoryTheory.decidableEqOfUnop

/-- The equivalence between isomorphisms of the form `A ≅ B` and `B.unop ≅ A.unop`.

Note this is definitionally the same as the other three variants:
* `(opposite.op A ≅ B) ≃ (B.unop ≅ A)`
* `(A ≅ opposite.op B) ≃ (B ≅ A.unop)`
* `(opposite.op A ≅ opposite.op B) ≃ (B ≅ A)`
-/
@[simps]
def isoOpEquiv (A B : Cᵒᵖ) : (A ≅ B) ≃ (B.unop ≅ A.unop)
    where
  toFun f := f.unop
  invFun g := g.op
  left_inv _ := by
    ext
    rfl
  right_inv _ := by
    ext
    rfl
#align category_theory.iso_op_equiv CategoryTheory.isoOpEquiv

namespace Functor

variable (C)

variable (D : Type u₂) [Category.{v₂} D]

/-- The equivalence of functor categories induced by `op` and `unop`.
-/
@[simps]
def opUnopEquiv : (C ⥤ D)ᵒᵖ ≌ Cᵒᵖ ⥤ Dᵒᵖ
    where
  functor := opHom _ _
  inverse := opInv _ _
  unitIso :=
    NatIso.ofComponents (fun F => F.unop.opUnopIso.op)
      (by
        intro F G f
        dsimp [opUnopIso]
        rw [show f = f.unop.op by simp, ← op_comp, ← op_comp]
        congr 1
        aesop_cat)
  counitIso := NatIso.ofComponents (fun F => F.unopOpIso) (by aesop_cat)
#align category_theory.functor.op_unop_equiv CategoryTheory.Functor.opUnopEquiv

/-- The equivalence of functor categories induced by `leftOp` and `rightOp`.
-/
@[simps!]
def leftOpRightOpEquiv : (Cᵒᵖ ⥤ D)ᵒᵖ ≌ C ⥤ Dᵒᵖ
    where
  functor :=
    { obj := fun F => F.unop.rightOp
      map := fun η => NatTrans.rightOp η.unop  }
  inverse :=
    { obj := fun F => op F.leftOp
      map := fun η => η.leftOp.op }
  unitIso :=
    NatIso.ofComponents (fun F => F.unop.rightOpLeftOpIso.op)
      (by
        intro F G η
        dsimp
        rw [show η = η.unop.op by simp, ← op_comp, ← op_comp]
        congr 1
        aesop_cat)
  counitIso := NatIso.ofComponents (fun F => F.leftOpRightOpIso) (by aesop_cat)
#align category_theory.functor.left_op_right_op_equiv CategoryTheory.Functor.leftOpRightOpEquiv

end Functor

end CategoryTheory


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.metric_space.lipschitz
import topology.uniform_space.complete_separated

/-!
# Antilipschitz functions

We say that a map `f : α → β` between two (extended) metric spaces is
`antilipschitz_with K`, `K ≥ 0`, if for all `x, y` we have `edist x y ≤ K * edist (f x) (f y)`.
For a metric space, the latter inequality is equivalent to `dist x y ≤ K * dist (f x) (f y)`.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ℝ≥0∞`. We do not require `0 < K` in the definition, mostly because
we do not have a `posreal` type.
-/

variables {α : Type*} {β : Type*} {γ : Type*}

open_locale nnreal ennreal uniformity
open set

/-- We say that `f : α → β` is `antilipschitz_with K` if for any two points `x`, `y` we have
`K * edist x y ≤ edist (f x) (f y)`. -/
def antilipschitz_with [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0) (f : α → β) :=
∀ x y, edist x y ≤ K * edist (f x) (f y)

lemma antilipschitz_with.edist_lt_top [pseudo_emetric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} (h : antilipschitz_with K f) (x y : α) : edist x y < ⊤ :=
(h x y).trans_lt $ ennreal.mul_lt_top ennreal.coe_ne_top (edist_ne_top _ _)

lemma antilipschitz_with.edist_ne_top [pseudo_emetric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} (h : antilipschitz_with K f) (x y : α) : edist x y ≠ ⊤ :=
(h.edist_lt_top x y).ne

section metric

variables [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0} {f : α → β}

lemma antilipschitz_with_iff_le_mul_nndist :
  antilipschitz_with K f ↔ ∀ x y, nndist x y ≤ K * nndist (f x) (f y) :=
by { simp only [antilipschitz_with, edist_nndist], norm_cast }

alias antilipschitz_with_iff_le_mul_nndist ↔ antilipschitz_with.le_mul_nndist
  antilipschitz_with.of_le_mul_nndist

lemma antilipschitz_with_iff_le_mul_dist :
  antilipschitz_with K f ↔ ∀ x y, dist x y ≤ K * dist (f x) (f y) :=
by { simp only [antilipschitz_with_iff_le_mul_nndist, dist_nndist], norm_cast }

alias antilipschitz_with_iff_le_mul_dist ↔ antilipschitz_with.le_mul_dist
  antilipschitz_with.of_le_mul_dist

namespace antilipschitz_with

lemma mul_le_nndist (hf : antilipschitz_with K f) (x y : α) :
  K⁻¹ * nndist x y ≤ nndist (f x) (f y) :=
by simpa only [div_eq_inv_mul] using nnreal.div_le_of_le_mul' (hf.le_mul_nndist x y)

lemma mul_le_dist (hf : antilipschitz_with K f) (x y : α) :
  (K⁻¹ * dist x y : ℝ) ≤ dist (f x) (f y) :=
by exact_mod_cast hf.mul_le_nndist x y

end antilipschitz_with

end metric

namespace antilipschitz_with

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {K : ℝ≥0} {f : α → β}

open emetric

/-- Extract the constant from `hf : antilipschitz_with K f`. This is useful, e.g.,
if `K` is given by a long formula, and we want to reuse this value. -/
@[nolint unused_arguments] -- uses neither `f` nor `hf`
protected def K (hf : antilipschitz_with K f) : ℝ≥0 := K

protected lemma injective {α : Type*} {β : Type*} [emetric_space α] [pseudo_emetric_space β]
  {K : ℝ≥0} {f : α → β} (hf : antilipschitz_with K f) : function.injective f :=
λ x y h, by simpa only [h, edist_self, mul_zero, edist_le_zero] using hf x y

lemma mul_le_edist (hf : antilipschitz_with K f) (x y : α) :
  (K⁻¹ * edist x y : ℝ≥0∞) ≤ edist (f x) (f y) :=
begin
  rw [mul_comm, ← div_eq_mul_inv],
  exact ennreal.div_le_of_le_mul' (hf x y)
end

lemma ediam_preimage_le (hf : antilipschitz_with K f) (s : set β) : diam (f ⁻¹' s) ≤ K * diam s :=
diam_le $ λ x hx y hy, (hf x y).trans $ mul_le_mul_left' (edist_le_diam_of_mem hx hy) K

lemma le_mul_ediam_image (hf : antilipschitz_with K f) (s : set α) : diam s ≤ K * diam (f '' s) :=
(diam_mono (subset_preimage_image _ _)).trans (hf.ediam_preimage_le (f '' s))

protected lemma id : antilipschitz_with 1 (id : α → α) :=
λ x y, by simp only [ennreal.coe_one, one_mul, id, le_refl]

lemma comp {Kg : ℝ≥0} {g : β → γ} (hg : antilipschitz_with Kg g)
  {Kf : ℝ≥0} {f : α → β} (hf : antilipschitz_with Kf f) :
  antilipschitz_with (Kf * Kg) (g ∘ f) :=
λ x y,
calc edist x y ≤ Kf * edist (f x) (f y) : hf x y
... ≤ Kf * (Kg * edist (g (f x)) (g (f y))) : ennreal.mul_left_mono (hg _ _)
... = _ : by rw [ennreal.coe_mul, mul_assoc]

lemma restrict (hf : antilipschitz_with K f) (s : set α) :
  antilipschitz_with K (s.restrict f) :=
λ x y, hf x y

lemma cod_restrict (hf : antilipschitz_with K f) {s : set β} (hs : ∀ x, f x ∈ s) :
  antilipschitz_with K (s.cod_restrict f hs) :=
λ x y, hf x y

lemma to_right_inv_on' {s : set α} (hf : antilipschitz_with K (s.restrict f))
  {g : β → α} {t : set β} (g_maps : maps_to g t s) (g_inv : right_inv_on g f t) :
  lipschitz_with K (t.restrict g) :=
λ x y, by simpa only [restrict_apply, g_inv x.mem, g_inv y.mem, subtype.edist_eq, subtype.coe_mk]
  using hf ⟨g x, g_maps x.mem⟩ ⟨g y, g_maps y.mem⟩

lemma to_right_inv_on (hf : antilipschitz_with K f) {g : β → α} {t : set β}
  (h : right_inv_on g f t) :
  lipschitz_with K (t.restrict g) :=
(hf.restrict univ).to_right_inv_on' (maps_to_univ g t) h

lemma to_right_inverse (hf : antilipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
  lipschitz_with K g :=
begin
  intros x y,
  have := hf (g x) (g y),
  rwa [hg x, hg y] at this
end

lemma comap_uniformity_le (hf : antilipschitz_with K f) :
  (𝓤 β).comap (prod.map f f) ≤ 𝓤 α :=
begin
  refine ((uniformity_basis_edist.comap _).le_basis_iff uniformity_basis_edist).2 (λ ε h₀, _),
  refine ⟨K⁻¹ * ε, ennreal.mul_pos (ennreal.inv_ne_zero.2 ennreal.coe_ne_top) h₀.ne', _⟩,
  refine λ x hx, (hf x.1 x.2).trans_lt _,
  rw [mul_comm, ← div_eq_mul_inv] at hx,
  rw mul_comm,
  exact ennreal.mul_lt_of_lt_div hx
end

protected lemma uniform_inducing (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  uniform_inducing f :=
⟨le_antisymm hf.comap_uniformity_le hfc.le_comap⟩

protected lemma uniform_embedding {α : Type*} {β : Type*} [emetric_space α] [pseudo_emetric_space β]
  {K : ℝ≥0} {f : α → β} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  uniform_embedding f :=
⟨hf.uniform_inducing hfc, hf.injective⟩

lemma is_complete_range [complete_space α] (hf : antilipschitz_with K f)
  (hfc : uniform_continuous f) : is_complete (range f) :=
(hf.uniform_inducing hfc).is_complete_range

lemma is_closed_range {α β : Type*} [pseudo_emetric_space α] [emetric_space β] [complete_space α]
  {f : α → β} {K : ℝ≥0} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  is_closed (range f) :=
(hf.is_complete_range hfc).is_closed

lemma closed_embedding {α : Type*} {β : Type*} [emetric_space α] [emetric_space β] {K : ℝ≥0}
  {f : α → β} [complete_space α] (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  closed_embedding f :=
{ closed_range := hf.is_closed_range hfc,
  .. (hf.uniform_embedding hfc).embedding }

lemma subtype_coe (s : set α) : antilipschitz_with 1 (coe : s → α) :=
antilipschitz_with.id.restrict s

lemma of_subsingleton [subsingleton α] {K : ℝ≥0} : antilipschitz_with K f :=
λ x y, by simp only [subsingleton.elim x y, edist_self, zero_le]

/-- If `f : α → β` is `0`-antilipschitz, then `α` is a `subsingleton`. -/
protected lemma subsingleton {α β} [emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (h : antilipschitz_with 0 f) : subsingleton α :=
⟨λ x y, edist_le_zero.1 $ (h x y).trans_eq $ zero_mul _⟩

end antilipschitz_with

namespace antilipschitz_with

open metric

variables [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0} {f : α → β}

lemma bounded_preimage (hf : antilipschitz_with K f)
  {s : set β} (hs : bounded s) :
  bounded (f ⁻¹' s) :=
exists.intro (K * diam s) $ λ x y hx hy,
calc dist x y ≤ K * dist (f x) (f y) : hf.le_mul_dist x y
... ≤ K * diam s : mul_le_mul_of_nonneg_left (dist_le_diam_of_mem hs hx hy) K.2

/-- The image of a proper space under an expanding onto map is proper. -/
protected lemma proper_space {α : Type*} [metric_space α] {K : ℝ≥0} {f : α → β} [proper_space α]
  (hK : antilipschitz_with K f) (f_cont : continuous f) (hf : function.surjective f) :
  proper_space β :=
begin
  apply proper_space_of_compact_closed_ball_of_le 0 (λx₀ r hr, _),
  let K := f ⁻¹' (closed_ball x₀ r),
  have A : is_closed K := is_closed_ball.preimage f_cont,
  have B : bounded K := hK.bounded_preimage bounded_closed_ball,
  have : is_compact K := compact_iff_closed_bounded.2 ⟨A, B⟩,
  convert this.image f_cont,
  exact (hf.image_preimage _).symm
end

end antilipschitz_with

lemma lipschitz_with.to_right_inverse [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
  {f : α → β} (hf : lipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
  antilipschitz_with K g :=
λ x y, by simpa only [hg _] using hf (g x) (g y)


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.continued_fractions.computation.approximations
import Mathlib.algebra.continued_fractions.computation.correctness_terminating
import Mathlib.data.rat.default
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Termination of Continued Fraction Computations (`gcf.of`)

## Summary
We show that the continued fraction for a value `v`, as defined in
`algebra.continued_fractions.computation.basic`, terminates if and only if `v` corresponds to a
rational number, that is `↑v = q` for some `q : ℚ`.

## Main Theorems

- `gcf.coe_of_rat` shows that `gcf.of v = gcf.of q` for `v : α` given that `↑v = q` and `q : ℚ`.
- `gcf.terminates_iff_rat` shows that `gcf.of v` terminates if and only if `↑v = q` for some
  `q : ℚ`.

## Tags

rational, continued fraction, termination
-/

namespace generalized_continued_fraction

/-
We will have to constantly coerce along our structures in the following proofs using their provided
map functions.
-/

/-!
We want to show that the computation of a continued fraction `gcf.of v` terminates if and only if
`v ∈ ℚ`. In the next section, we show the implication from left to right.

We first show that every finite convergent corresponds to a rational number `q` and then use the
finite correctness proof (`of_correctness_of_terminates`) of `gcf.of` to show that `v = ↑q`.
-/

theorem exists_gcf_pair_rat_eq_of_nth_conts_aux {K : Type u_1} [linear_ordered_field K] [floor_ring K] (v : K) (n : ℕ) : ∃ (conts : pair ℚ), continuants_aux (generalized_continued_fraction.of v) n = pair.map coe conts := sorry

theorem exists_gcf_pair_rat_eq_nth_conts {K : Type u_1} [linear_ordered_field K] [floor_ring K] (v : K) (n : ℕ) : ∃ (conts : pair ℚ), continuants (generalized_continued_fraction.of v) n = pair.map coe conts := sorry

theorem exists_rat_eq_nth_numerator {K : Type u_1} [linear_ordered_field K] [floor_ring K] (v : K) (n : ℕ) : ∃ (q : ℚ), numerators (generalized_continued_fraction.of v) n = ↑q := sorry

theorem exists_rat_eq_nth_denominator {K : Type u_1} [linear_ordered_field K] [floor_ring K] (v : K) (n : ℕ) : ∃ (q : ℚ), denominators (generalized_continued_fraction.of v) n = ↑q := sorry

/-- Every finite convergent corresponds to a rational number. -/
theorem exists_rat_eq_nth_convergent {K : Type u_1} [linear_ordered_field K] [floor_ring K] (v : K) (n : ℕ) : ∃ (q : ℚ), convergents (generalized_continued_fraction.of v) n = ↑q := sorry

/-- Every terminating continued fraction corresponds to a rational number. -/
theorem exists_rat_eq_of_terminates {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} (terminates : terminates (generalized_continued_fraction.of v)) : ∃ (q : ℚ), v = ↑q := sorry

/-!
Before we can show that the continued fraction of a rational number terminates, we have to prove
some technical translation lemmas. More precisely, in this section, we show that, given a rational
number `q : ℚ` and value `v : K` with `v = ↑q`, the continued fraction of `q` and `v` coincide.
In particular, we show that `(↑(gcf.of q : gcf ℚ) : gcf K) = gcf.of v` in `gcf.coe_of_rat`.

To do this, we proceed bottom-up, showing the correspondence between the basic functions involved in
the computation first and then lift the results step-by-step.
-/

/- The lifting works for arbitrary linear ordered, archimedean fields with a floor function. -/

/-! First, we show the correspondence for the very basic functions in `gcf.int_fract_pair`. -/

namespace int_fract_pair

theorem coe_of_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) : mapFr coe (int_fract_pair.of q) = int_fract_pair.of v := sorry

theorem coe_stream_nth_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) (n : ℕ) : option.map (mapFr coe) (int_fract_pair.stream q n) = int_fract_pair.stream v n := sorry

theorem coe_stream_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) : stream.map (option.map (mapFr coe)) (int_fract_pair.stream q) = int_fract_pair.stream v :=
  funext fun (n : ℕ) => coe_stream_nth_rat_eq v_eq_q n

end int_fract_pair

/-! Now we lift the coercion results to the continued fraction computation. -/

theorem coe_of_h_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) : ↑(h (generalized_continued_fraction.of q)) = h (generalized_continued_fraction.of v) := sorry

theorem coe_of_s_nth_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) (n : ℕ) : option.map (pair.map coe) (seq.nth (s (generalized_continued_fraction.of q)) n) =
  seq.nth (s (generalized_continued_fraction.of v)) n := sorry

theorem coe_of_s_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) : seq.map (pair.map coe) (s (generalized_continued_fraction.of q)) = s (generalized_continued_fraction.of v) := sorry

/-- Given `(v : K), (q : ℚ), and v = q`, we have that `gcf.of q = gcf.of v` -/
theorem coe_of_rat_eq {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) : mk (↑(h (generalized_continued_fraction.of q))) (seq.map (pair.map coe) (s (generalized_continued_fraction.of q))) =
  generalized_continued_fraction.of v := sorry

theorem of_terminates_iff_of_rat_terminates {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] {v : K} {q : ℚ} (v_eq_q : v = ↑q) : terminates (generalized_continued_fraction.of v) ↔ terminates (generalized_continued_fraction.of q) := sorry

/-!
Finally, we show that the continued fraction of a rational number terminates.

The crucial insight is that, given any `q : ℚ` with `0 < q < 1`, the numerator of `fract q` is
smaller than the numerator of `q`. As the continued fraction computation recursively operates on
the fractional part of a value `v` and `0 ≤ fract v < 1`, we infer that the numerator of the
fractional part in the computation decreases by at least one in each step. As `0 ≤ fract v`,
this process must stop after finite number of steps, and the computation hence terminates.
-/

namespace int_fract_pair

/--
Shows that for any `q : ℚ` with `0 < q < 1`, the numerator of the fractional part of
`int_fract_pair.of q⁻¹` is smaller than the numerator of `q`.
-/
theorem of_inv_fr_num_lt_num_of_pos {q : ℚ} (q_pos : 0 < q) : rat.num (fr (int_fract_pair.of (q⁻¹))) < rat.num q :=
  rat.fract_inv_num_lt_num_of_pos q_pos

/-- Shows that the sequence of numerators of the fractional parts of the stream is strictly
monotonically decreasing. -/
theorem stream_succ_nth_fr_num_lt_nth_fr_num_rat {q : ℚ} {n : ℕ} {ifp_n : int_fract_pair ℚ} {ifp_succ_n : int_fract_pair ℚ} (stream_nth_eq : int_fract_pair.stream q n = some ifp_n) (stream_succ_nth_eq : int_fract_pair.stream q (n + 1) = some ifp_succ_n) : rat.num (fr ifp_succ_n) < rat.num (fr ifp_n) := sorry

theorem stream_nth_fr_num_le_fr_num_sub_n_rat {q : ℚ} {n : ℕ} {ifp_n : int_fract_pair ℚ} : int_fract_pair.stream q n = some ifp_n → rat.num (fr ifp_n) ≤ rat.num (fr (int_fract_pair.of q)) - ↑n := sorry

theorem exists_nth_stream_eq_none_of_rat (q : ℚ) : ∃ (n : ℕ), int_fract_pair.stream q n = none := sorry

end int_fract_pair

/-- The continued fraction of a rational number terminates. -/
theorem terminates_of_rat (q : ℚ) : terminates (generalized_continued_fraction.of q) := sorry

/-- The continued fraction `gcf.of v` terminates if and only if `v ∈ ℚ`. -/
theorem terminates_iff_rat {K : Type u_1} [linear_ordered_field K] [floor_ring K] [archimedean K] (v : K) : terminates (generalized_continued_fraction.of v) ↔ ∃ (q : ℚ), v = ↑q := sorry


/-
Copyright (c) 2019 Amelia Livingston. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Amelia Livingston, Bryan Gin-ge Chen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.setoid.basic
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Equivalence relations: partitions

This file comprises properties of equivalence relations viewed as partitions.

## Tags

setoid, equivalence, iseqv, relation, equivalence relation, partition, equivalence class
-/

namespace setoid

/-- If x ∈ α is in 2 elements of a set of sets partitioning α, those 2 sets are equal. -/
theorem eq_of_mem_eqv_class {α : Type u_1} {c : set (set α)} (H : ∀ (a : α), exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b) {x : α} {b : set α} {b' : set α} (hc : b ∈ c) (hb : x ∈ b) (hc' : b' ∈ c) (hb' : x ∈ b') : b = b' :=
  exists_unique.unique2 (H x) hc hb hc' hb'

/-- Makes an equivalence relation from a set of sets partitioning α. -/
def mk_classes {α : Type u_1} (c : set (set α)) (H : ∀ (a : α), exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b) : setoid α :=
  mk (fun (x y : α) => ∀ (s : set α), s ∈ c → x ∈ s → y ∈ s) sorry

/-- Makes the equivalence classes of an equivalence relation. -/
def classes {α : Type u_1} (r : setoid α) : set (set α) :=
  set_of fun (s : set α) => ∃ (y : α), s = set_of fun (x : α) => rel r x y

theorem mem_classes {α : Type u_1} (r : setoid α) (y : α) : (set_of fun (x : α) => rel r x y) ∈ classes r :=
  Exists.intro y rfl

/-- Two equivalence relations are equal iff all their equivalence classes are equal. -/
theorem eq_iff_classes_eq {α : Type u_1} {r₁ : setoid α} {r₂ : setoid α} : r₁ = r₂ ↔ ∀ (x : α), (set_of fun (y : α) => rel r₁ x y) = set_of fun (y : α) => rel r₂ x y := sorry

theorem rel_iff_exists_classes {α : Type u_1} (r : setoid α) {x : α} {y : α} : rel r x y ↔ ∃ (c : set α), ∃ (H : c ∈ classes r), x ∈ c ∧ y ∈ c := sorry

/-- Two equivalence relations are equal iff their equivalence classes are equal. -/
theorem classes_inj {α : Type u_1} {r₁ : setoid α} {r₂ : setoid α} : r₁ = r₂ ↔ classes r₁ = classes r₂ := sorry

/-- The empty set is not an equivalence class. -/
theorem empty_not_mem_classes {α : Type u_1} {r : setoid α} : ¬∅ ∈ classes r := sorry

/-- Equivalence classes partition the type. -/
theorem classes_eqv_classes {α : Type u_1} {r : setoid α} (a : α) : exists_unique fun (b : set α) => exists_unique fun (H : b ∈ classes r) => a ∈ b := sorry

/-- If x ∈ α is in 2 equivalence classes, the equivalence classes are equal. -/
theorem eq_of_mem_classes {α : Type u_1} {r : setoid α} {x : α} {b : set α} (hc : b ∈ classes r) (hb : x ∈ b) {b' : set α} (hc' : b' ∈ classes r) (hb' : x ∈ b') : b = b' :=
  eq_of_mem_eqv_class classes_eqv_classes hc hb hc' hb'

/-- The elements of a set of sets partitioning α are the equivalence classes of the
    equivalence relation defined by the set of sets. -/
theorem eq_eqv_class_of_mem {α : Type u_1} {c : set (set α)} (H : ∀ (a : α), exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b) {s : set α} {y : α} (hs : s ∈ c) (hy : y ∈ s) : s = set_of fun (x : α) => rel (mk_classes c H) x y := sorry

/-- The equivalence classes of the equivalence relation defined by a set of sets
    partitioning α are elements of the set of sets. -/
theorem eqv_class_mem {α : Type u_1} {c : set (set α)} (H : ∀ (a : α), exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b) {y : α} : (set_of fun (x : α) => rel (mk_classes c H) x y) ∈ c :=
  exists_unique.elim2 (H y)
    fun (b : set α) (hc : b ∈ c) (hy : y ∈ b) (hb : ∀ (y_1 : set α), y_1 ∈ c → y ∈ y_1 → y_1 = b) =>
      eq_eqv_class_of_mem H hc hy ▸ hc

/-- Distinct elements of a set of sets partitioning α are disjoint. -/
theorem eqv_classes_disjoint {α : Type u_1} {c : set (set α)} (H : ∀ (a : α), exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b) : set.pairwise_disjoint c := sorry

/-- A set of disjoint sets covering α partition α (classical). -/
theorem eqv_classes_of_disjoint_union {α : Type u_1} {c : set (set α)} (hu : ⋃₀c = set.univ) (H : set.pairwise_disjoint c) (a : α) : exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b := sorry

/-- Makes an equivalence relation from a set of disjoints sets covering α. -/
def setoid_of_disjoint_union {α : Type u_1} {c : set (set α)} (hu : ⋃₀c = set.univ) (H : set.pairwise_disjoint c) : setoid α :=
  mk_classes c (eqv_classes_of_disjoint_union hu H)

/-- The equivalence relation made from the equivalence classes of an equivalence
    relation r equals r. -/
theorem mk_classes_classes {α : Type u_1} (r : setoid α) : mk_classes (classes r) classes_eqv_classes = r := sorry

@[simp] theorem sUnion_classes {α : Type u_1} (r : setoid α) : ⋃₀classes r = set.univ :=
  set.eq_univ_of_forall
    fun (x : α) =>
      iff.mpr set.mem_sUnion (Exists.intro (set_of fun (y : α) => rel r y x) (Exists.intro (Exists.intro x rfl) (refl x)))

/-- A collection `c : set (set α)` of sets is a partition of `α` into pairwise
disjoint sets if `∅ ∉ c` and each element `a : α` belongs to a unique set `b ∈ c`. -/
def is_partition {α : Type u_1} (c : set (set α)) :=
  ¬∅ ∈ c ∧ ∀ (a : α), exists_unique fun (b : set α) => exists_unique fun (H : b ∈ c) => a ∈ b

/-- A partition of `α` does not contain the empty set. -/
theorem nonempty_of_mem_partition {α : Type u_1} {c : set (set α)} (hc : is_partition c) {s : set α} (h : s ∈ c) : set.nonempty s :=
  iff.mp set.ne_empty_iff_nonempty fun (hs0 : s = ∅) => and.left hc (hs0 ▸ h)

theorem is_partition_classes {α : Type u_1} (r : setoid α) : is_partition (classes r) :=
  { left := empty_not_mem_classes, right := classes_eqv_classes }

theorem is_partition.pairwise_disjoint {α : Type u_1} {c : set (set α)} (hc : is_partition c) : set.pairwise_disjoint c :=
  eqv_classes_disjoint (and.right hc)

theorem is_partition.sUnion_eq_univ {α : Type u_1} {c : set (set α)} (hc : is_partition c) : ⋃₀c = set.univ := sorry

/-- All elements of a partition of α are the equivalence class of some y ∈ α. -/
theorem exists_of_mem_partition {α : Type u_1} {c : set (set α)} (hc : is_partition c) {s : set α} (hs : s ∈ c) : ∃ (y : α), s = set_of fun (x : α) => rel (mk_classes c (and.right hc)) x y := sorry

/-- The equivalence classes of the equivalence relation defined by a partition of α equal
    the original partition. -/
theorem classes_mk_classes {α : Type u_1} (c : set (set α)) (hc : is_partition c) : classes (mk_classes c (and.right hc)) = c := sorry

/-- Defining `≤` on partitions as the `≤` defined on their induced equivalence relations. -/
protected instance partition.le {α : Type u_1} : HasLessEq (Subtype is_partition) :=
  { LessEq := fun (x y : Subtype is_partition) => mk_classes (subtype.val x) sorry ≤ mk_classes (subtype.val y) sorry }

/-- Defining a partial order on partitions as the partial order on their induced
    equivalence relations. -/
protected instance partition.partial_order {α : Type u_1} : partial_order (Subtype is_partition) :=
  partial_order.mk LessEq (fun (x y : Subtype is_partition) => x ≤ y ∧ ¬y ≤ x) sorry sorry sorry

/-- The order-preserving bijection between equivalence relations and partitions of sets. -/
def partition.rel_iso (α : Type u_1) : setoid α ≃o Subtype is_partition :=
  rel_iso.mk
    (equiv.mk (fun (r : setoid α) => { val := classes r, property := sorry })
      (fun (x : Subtype is_partition) => mk_classes (subtype.val x) sorry) mk_classes_classes sorry)
    sorry

/-- A complete lattice instance for partitions; there is more infrastructure for the
    equivalent complete lattice on equivalence relations. -/
protected instance partition.complete_lattice {α : Type u_1} : complete_lattice (Subtype is_partition) :=
  galois_insertion.lift_complete_lattice (rel_iso.to_galois_insertion (partition.rel_iso α))


import combinatorics.simple_graph.subgraph
import combinatorics.simple_graph.connectivity
import combinatorics.simple_graph.matching
import set_theory.cardinal.basic
import set_theory.cardinal.finite
import set_theory.cardinal.ordinal
import local.cardinal
import local.set
universe univ

namespace simple_graph
namespace subgraph
variables {V : Type univ} {G : simple_graph V} {M : G.subgraph}

noncomputable
theorem to_simple_graph (M: G.subgraph): simple_graph V :=
 { adj := M.adj, symm := @adj_symm _ _ M, loopless := M.loopless }

theorem ne_of_adj (M: G.subgraph) {u v: V}: M.adj u v → u ≠ v :=
begin
  intros hadj heq,
  rw [heq] at hadj,
  exact M.loopless _ hadj,
end

@[simp]
theorem sup_verts (M N: G.subgraph):
  (M ⊔ N).verts =  M.verts ⊔ N.verts := by refl

@[simp]
theorem sup_adj_iff (M N: G.subgraph) (u v: V):
  (M ⊔ N).adj u v ↔ M.adj u v ∨ N.adj u v := by refl

theorem sub_adj_unique_iff_not_left (M N: G.subgraph) {u: V} (hu: u ∉ M.verts):
  (∃! v, (M ⊔ N).adj u v) ↔ ∃! v, N.adj u v :=
by simp [(not_imp_not.mpr M.edge_vert) hu]

theorem sub_adj_unique_iff_not_right (M N: G.subgraph) {u: V} (hu: u ∉ N.verts):
  (∃! v, (M ⊔ N).adj u v) ↔ ∃! v, M.adj u v :=
by simp [(not_imp_not.mpr N.edge_vert) hu]

def sdiff (s t: G.subgraph): G.subgraph := s.delete_edges t.edge_set

instance: has_sdiff (G.subgraph) := ⟨ sdiff ⟩

@[simp]
theorem sdiff_verts (M N: G.subgraph):
  (M \ N).verts = M.verts :=
by simp [has_sdiff.sdiff, sdiff]

@[simp]
theorem sdiff_adj_iff (M N: G.subgraph) (u v: V):
  (M \ N).adj u v ↔ M.adj u v ∧ ¬ N.adj u v := by refl

@[simp]
theorem symm_diff_verts (M N: G.subgraph):
  (M ∆ N).verts = M.verts ⊔ N.verts := begin
  simp [symm_diff, sdiff]
end

theorem symm_diff_verts_not_left (M N: G.subgraph) {v: V} (h: v ∉ M.verts):
  v ∈ (M ∆ N).verts → v ∈ N.verts := by simp[h]

theorem symm_diff_verts_not_right (M N: G.subgraph) {v: V} (h: v ∉ N.verts):
  v ∈ (M ∆ N).verts → v ∈ M.verts := by simp[h]

@[simp]
theorem symm_diff_adj_iff (M N: G.subgraph) (u v: V):
  (M ∆ N).adj u v ↔ xor (M.adj u v) (N.adj u v) := by simp [symm_diff, xor]

theorem symm_diff_adj_unique_left (M N: G.subgraph) (u: V) (hN: ∀ v, ¬ (N \ M).adj u v):
  (∃! v, (M \ N).adj u v) → ∃! v, (M ∆ N).adj u v := by simp [symm_diff, hN]

theorem symm_diff_adj_unique_left' (M N: G.subgraph) (u: V) (hN: ∀ v, ¬ N.adj u v):
  (∃! v, M.adj u v) → ∃! v, (M ∆ N).adj u v := by simp [symm_diff, hN]

theorem symm_diff_adj_unique_right (M N: G.subgraph) (u: V) (hM: ∀ v, ¬ (M \ N).adj u v):
  (∃! v, (N \ M).adj u v) → ∃! v, (M ∆ N).adj u v := by simp [symm_diff, hM]

theorem symm_diff_adj_unique_right' (M N: G.subgraph) (u: V) (hM: ∀ v, ¬ M.adj u v):
  (∃! v, N.adj u v) → ∃! v, (M ∆ N).adj u v := by simp [hM]

lemma degree_eq_one_iff_unique_adj' {G' : G.subgraph} {v : V}:
  cardinal.mk (G'.neighbor_set v) = 1 ↔ ∃! (w : V), G'.adj v w :=
by simp [cardinal.eq_one_iff_exists_unique, set_coe.exists_unique, mem_neighbor_set]

end subgraph
end simple_graph


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.algebra.subalgebra.basic
import algebra.algebra.bilinear

/-!
# Towers of algebras

In this file we prove basic facts about towers of algebra.

An algebra tower A/S/R is expressed by having instances of `algebra A S`,
`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

An important definition is `to_alg_hom R S A`, the canonical `R`-algebra homomorphism `S →ₐ[R] A`.

-/

open_locale pointwise
universes u v w u₁ v₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁) (M : Type v₁)

namespace algebra

variables [comm_semiring R] [semiring A] [algebra R A]
variables [add_comm_monoid M] [module R M] [module A M] [is_scalar_tower R A M]

variables {A}

/-- The `R`-algebra morphism `A → End (M)` corresponding to the representation of the algebra `A`
on the `R`-module `M`.

This is a stronger version of `distrib_mul_action.to_linear_map`, and could also have been
called `algebra.to_module_End`. -/
def lsmul : A →ₐ[R] module.End R M :=
{ to_fun := distrib_mul_action.to_linear_map R M,
  map_one' := linear_map.ext $ λ _, one_smul A _,
  map_mul' := λ a b, linear_map.ext $ smul_assoc a b,
  map_zero' := linear_map.ext $ λ _, zero_smul A _,
  map_add' := λ a b, linear_map.ext $ λ _, add_smul _ _ _,
  commutes' := λ r, linear_map.ext $ algebra_map_smul A r, }

@[simp] lemma lsmul_coe (a : A) : (lsmul R M a : M → M) = (•) a := rfl

lemma lmul_algebra_map (x : R) :
  lmul R A (algebra_map R A x) = algebra.lsmul R A x :=
eq.symm $ linear_map.ext $ smul_def x

end algebra

namespace is_scalar_tower

section module

variables [comm_semiring R] [semiring A] [algebra R A]
variables [has_scalar R M] [mul_action A M] [is_scalar_tower R A M]

variables {R} (A) {M}
theorem algebra_map_smul (r : R) (x : M) : algebra_map R A r • x = r • x :=
by rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul]

end module

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B]

variables {R S A}
theorem of_algebra_map_eq [algebra R A]
  (h : ∀ x, algebra_map R A x = algebra_map S A (algebra_map R S x)) :
  is_scalar_tower R S A :=
⟨λ x y z, by simp_rw [algebra.smul_def, ring_hom.map_mul, mul_assoc, h]⟩

/-- See note [partially-applied ext lemmas]. -/
theorem of_algebra_map_eq' [algebra R A]
  (h : algebra_map R A = (algebra_map S A).comp (algebra_map R S)) :
  is_scalar_tower R S A :=
of_algebra_map_eq $ ring_hom.ext_iff.1 h

variables (R S A)

instance subalgebra (S₀ : subalgebra R S) : is_scalar_tower S₀ S A :=
of_algebra_map_eq $ λ x, rfl

variables [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

theorem algebra_map_eq :
  algebra_map R A = (algebra_map S A).comp (algebra_map R S) :=
ring_hom.ext $ λ x, by simp_rw [ring_hom.comp_apply, algebra.algebra_map_eq_smul_one,
    smul_assoc, one_smul]

theorem algebra_map_apply (x : R) : algebra_map R A x = algebra_map S A (algebra_map R S x) :=
by rw [algebra_map_eq R S A, ring_hom.comp_apply]

instance subalgebra' (S₀ : subalgebra R S) : is_scalar_tower R S₀ A :=
@is_scalar_tower.of_algebra_map_eq R S₀ A _ _ _ _ _ _ $ λ _,
(is_scalar_tower.algebra_map_apply R S A _ : _)

@[ext] lemma algebra.ext {S : Type u} {A : Type v} [comm_semiring S] [semiring A]
  (h1 h2 : algebra S A) (h : ∀ (r : S) (x : A), (by haveI := h1; exact r • x) = r • x) : h1 = h2 :=
algebra.algebra_ext _ _ $ λ r, by
  simpa only [@algebra.smul_def _ _ _ _ h1, @algebra.smul_def _ _ _ _ h2, mul_one] using h r 1

/-- In a tower, the canonical map from the middle element to the top element is an
algebra homomorphism over the bottom element. -/
def to_alg_hom : S →ₐ[R] A :=
{ commutes' := λ _, (algebra_map_apply _ _ _ _).symm,
  .. algebra_map S A }

lemma to_alg_hom_apply (y : S) : to_alg_hom R S A y = algebra_map S A y := rfl

@[simp] lemma coe_to_alg_hom : ↑(to_alg_hom R S A) = algebra_map S A :=
ring_hom.ext $ λ _, rfl

@[simp] lemma coe_to_alg_hom' : (to_alg_hom R S A : S → A) = algebra_map S A :=
rfl

variables {R S A B}

@[simp, priority 900] lemma _root_.alg_hom.map_algebra_map (f : A →ₐ[S] B) (r : R) :
  f (algebra_map R A r) = algebra_map R B r :=
by rw [algebra_map_apply R S A r, f.commutes, ← algebra_map_apply R S B]

variables (R)

@[simp, priority 900] lemma _root_.alg_hom.comp_algebra_map_of_tower (f : A →ₐ[S] B) :
  (f : A →+* B).comp (algebra_map R A) = algebra_map R B :=
ring_hom.ext f.map_algebra_map

variables (R) {S A B}

-- conflicts with is_scalar_tower.subalgebra
@[priority 999] instance subsemiring (U : subsemiring S) : is_scalar_tower U S A :=
of_algebra_map_eq $ λ x, rfl

@[nolint instance_priority]
instance of_ring_hom {R A B : Type*} [comm_semiring R] [comm_semiring A] [comm_semiring B]
  [algebra R A] [algebra R B] (f : A →ₐ[R] B) :
  @is_scalar_tower R A B _ (f.to_ring_hom.to_algebra.to_has_scalar) _ :=
by { letI := (f : A →+* B).to_algebra, exact of_algebra_map_eq (λ x, (f.commutes x).symm) }

end semiring

end is_scalar_tower

section homs

variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B]
variables [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R) {A S B}

open is_scalar_tower

namespace alg_hom

/-- R ⟶ S induces S-Alg ⥤ R-Alg -/
def restrict_scalars (f : A →ₐ[S] B) : A →ₐ[R] B :=
{ commutes' := λ r, by { rw [algebra_map_apply R S A, algebra_map_apply R S B],
    exact f.commutes (algebra_map R S r) },
  .. (f : A →+* B) }

lemma restrict_scalars_apply (f : A →ₐ[S] B) (x : A) : f.restrict_scalars R x = f x := rfl

@[simp] lemma coe_restrict_scalars (f : A →ₐ[S] B) : (f.restrict_scalars R : A →+* B) = f := rfl

@[simp] lemma coe_restrict_scalars' (f : A →ₐ[S] B) : (restrict_scalars R f : A → B) = f := rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : (A →ₐ[S] B) → (A →ₐ[R] B)) :=
λ f g h, alg_hom.ext (alg_hom.congr_fun h : _)

end alg_hom

namespace alg_equiv

/-- R ⟶ S induces S-Alg ⥤ R-Alg -/
def restrict_scalars (f : A ≃ₐ[S] B) : A ≃ₐ[R] B :=
{ commutes' := λ r, by { rw [algebra_map_apply R S A, algebra_map_apply R S B],
    exact f.commutes (algebra_map R S r) },
  .. (f : A ≃+* B) }

lemma restrict_scalars_apply (f : A ≃ₐ[S] B) (x : A) : f.restrict_scalars R x = f x := rfl

@[simp] lemma coe_restrict_scalars (f : A ≃ₐ[S] B) : (f.restrict_scalars R : A ≃+* B) = f := rfl

@[simp] lemma coe_restrict_scalars' (f : A ≃ₐ[S] B) : (restrict_scalars R f : A → B) = f := rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : (A ≃ₐ[S] B) → (A ≃ₐ[R] B)) :=
λ f g h, alg_equiv.ext (alg_equiv.congr_fun h : _)

end alg_equiv

end homs

namespace subalgebra

open is_scalar_tower

section semiring

variables (R) {S A B} [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra R A] [algebra S B] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

/-- Given a scalar tower `R`, `S`, `A` of algebras, reinterpret an `S`-subalgebra of `A` an as an
`R`-subalgebra. -/
def restrict_scalars (U : subalgebra S A) : subalgebra R A :=
{ algebra_map_mem' := λ x, by { rw algebra_map_apply R S A, exact U.algebra_map_mem _ },
  .. U }

@[simp] lemma coe_restrict_scalars {U : subalgebra S A} :
  (restrict_scalars R U : set A) = (U : set A) := rfl

@[simp] lemma restrict_scalars_top : restrict_scalars R (⊤ : subalgebra S A) = ⊤ :=
set_like.coe_injective rfl

@[simp] lemma restrict_scalars_to_submodule {U : subalgebra S A} :
  (U.restrict_scalars R).to_submodule = U.to_submodule.restrict_scalars R :=
set_like.coe_injective rfl

@[simp] lemma mem_restrict_scalars {U : subalgebra S A} {x : A} :
  x ∈ restrict_scalars R U ↔ x ∈ U := iff.rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : subalgebra S A → subalgebra R A) :=
λ U V H, ext $ λ x, by rw [← mem_restrict_scalars R, H, mem_restrict_scalars]

/-- Produces an `R`-algebra map from `U.restrict_scalars R` given an `S`-algebra map from `U`.

This is a special case of `alg_hom.restrict_scalars` that can be helpful in elaboration. -/
@[simp]
def of_restrict_scalars (U : subalgebra S A) (f : U →ₐ[S] B) : U.restrict_scalars R →ₐ[R] B :=
f.restrict_scalars R

end semiring

end subalgebra

namespace algebra

variables {R A} [comm_semiring R] [semiring A] [algebra R A]
variables {M} [add_comm_monoid M] [module A M] [module R M] [is_scalar_tower R A M]

lemma span_restrict_scalars_eq_span_of_surjective
  (h : function.surjective (algebra_map R A)) (s : set M) :
  (submodule.span A s).restrict_scalars R = submodule.span R s :=
begin
  refine le_antisymm (λ x hx, _) (submodule.span_subset_span _ _ _),
  refine submodule.span_induction hx _ _ _ _,
  { exact λ x hx, submodule.subset_span hx },
  { exact submodule.zero_mem _ },
  { exact λ x y, submodule.add_mem _ },
  { intros c x hx,
    obtain ⟨c', rfl⟩ := h c,
    rw is_scalar_tower.algebra_map_smul,
    exact submodule.smul_mem _ _ hx },
end

lemma coe_span_eq_span_of_surjective
  (h : function.surjective (algebra_map R A)) (s : set M) :
  (submodule.span A s : set M) = submodule.span R s :=
congr_arg coe (algebra.span_restrict_scalars_eq_span_of_surjective h s)

end algebra

namespace is_scalar_tower

open subalgebra

variables [comm_semiring R] [comm_semiring S] [comm_semiring A]
variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]

theorem adjoin_range_to_alg_hom (t : set A) :
  (algebra.adjoin (to_alg_hom R S A).range t).restrict_scalars R =
    (algebra.adjoin S t).restrict_scalars R :=
subalgebra.ext $ λ z,
show z ∈ subsemiring.closure (set.range (algebra_map (to_alg_hom R S A).range A) ∪ t : set A) ↔
  z ∈ subsemiring.closure (set.range (algebra_map S A) ∪ t : set A),
from suffices set.range (algebra_map (to_alg_hom R S A).range A) = set.range (algebra_map S A),
  by rw this,
by { ext z, exact ⟨λ ⟨⟨x, y, h1⟩, h2⟩, ⟨y, h2 ▸ h1⟩, λ ⟨y, hy⟩, ⟨⟨z, y, hy⟩, rfl⟩⟩ }

end is_scalar_tower

section semiring

variables {R S A}

namespace submodule

section module

variables [semiring R] [semiring S] [add_comm_monoid A]
variables [module R S] [module S A] [module R A] [is_scalar_tower R S A]

open is_scalar_tower

theorem smul_mem_span_smul_of_mem {s : set S} {t : set A} {k : S} (hks : k ∈ span R s)
  {x : A} (hx : x ∈ t) : k • x ∈ span R (s • t) :=
span_induction hks (λ c hc, subset_span $ set.mem_smul.2 ⟨c, x, hc, hx, rfl⟩)
  (by { rw zero_smul, exact zero_mem _ })
  (λ c₁ c₂ ih₁ ih₂, by { rw add_smul, exact add_mem ih₁ ih₂ })
  (λ b c hc, by { rw is_scalar_tower.smul_assoc, exact smul_mem _ _ hc })

variables [smul_comm_class R S A]

theorem smul_mem_span_smul {s : set S} (hs : span R s = ⊤) {t : set A} {k : S}
  {x : A} (hx : x ∈ span R t) :
  k • x ∈ span R (s • t) :=
span_induction hx (λ x hx, smul_mem_span_smul_of_mem (hs.symm ▸ mem_top) hx)
  (by { rw smul_zero, exact zero_mem _ })
  (λ x y ihx ihy, by { rw smul_add, exact add_mem ihx ihy })
  (λ c x hx, smul_comm c k x ▸ smul_mem _ _ hx)

theorem span_smul {s : set S} (hs : span R s = ⊤) (t : set A) :
  span R (s • t) = (span S t).restrict_scalars R :=
le_antisymm (span_le.2 $ λ x hx, let ⟨p, q, hps, hqt, hpqx⟩ := set.mem_smul.1 hx in
  hpqx ▸ (span S t).smul_mem p (subset_span hqt)) $
λ p hp, span_induction hp (λ x hx, one_smul S x ▸ smul_mem_span_smul hs (subset_span hx))
  (zero_mem _)
  (λ _ _, add_mem)
  (λ k x hx, smul_mem_span_smul' hs hx)

end module

section algebra

variables [comm_semiring R] [semiring S] [add_comm_monoid A]
variables [algebra R S] [module S A] [module R A] [is_scalar_tower R S A]

/-- A variant of `submodule.span_image` for `algebra_map`. -/
lemma span_algebra_map_image (a : set R) :
  submodule.span R (algebra_map R S '' a) =
    (submodule.span R a).map (algebra.linear_map R S) :=
(submodule.span_image $ algebra.linear_map R S).trans rfl

lemma span_algebra_map_image_of_tower {S T : Type*} [comm_semiring S] [semiring T]
  [module R S] [is_scalar_tower R S S] [algebra R T] [algebra S T] [is_scalar_tower R S T]
  (a : set S) :
  submodule.span R (algebra_map S T '' a) =
    (submodule.span R a).map ((algebra.linear_map S T).restrict_scalars R) :=
(submodule.span_image $ (algebra.linear_map S T).restrict_scalars R).trans rfl

lemma map_mem_span_algebra_map_image {S T : Type*} [comm_semiring S] [semiring T]
  [algebra R S] [algebra R T] [algebra S T] [is_scalar_tower R S T]
  (x : S) (a : set S) (hx : x ∈ submodule.span R a) :
  algebra_map S T x ∈ submodule.span R (algebra_map S T '' a) :=
by { rw [span_algebra_map_image_of_tower, mem_map], exact ⟨x, hx, rfl⟩ }

end algebra

end submodule

end semiring

section ring

namespace algebra

variables [comm_semiring R] [semiring A] [algebra R A]
variables [add_comm_group M] [module A M] [module R M] [is_scalar_tower R A M]

lemma lsmul_injective [no_zero_smul_divisors A M] {x : A} (hx : x ≠ 0) :
  function.injective (lsmul R M x) :=
smul_right_injective _ hx

end algebra

end ring


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan, David Loeffler

! This file was ported from Lean 3 source module number_theory.bernoulli_polynomials
! leanprover-community/mathlib commit ca3d21f7f4fd613c2a3c54ac7871163e1e5ecb3a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.AlgebraMap
import Mathbin.Data.Polynomial.Derivative
import Mathbin.Data.Nat.Choose.Cast
import Mathbin.NumberTheory.Bernoulli

/-!
# Bernoulli polynomials

The [Bernoulli polynomials](https://en.wikipedia.org/wiki/Bernoulli_polynomials)
are an important tool obtained from Bernoulli numbers.

## Mathematical overview

The $n$-th Bernoulli polynomial is defined as
$$ B_n(X) = ∑_{k = 0}^n {n \choose k} (-1)^k  B_k  X^{n - k} $$
where $B_k$ is the $k$-th Bernoulli number. The Bernoulli polynomials are generating functions,
$$ \frac{t  e^{tX} }{ e^t - 1} = ∑_{n = 0}^{\infty} B_n(X)  \frac{t^n}{n!} $$

## Implementation detail

Bernoulli polynomials are defined using `bernoulli`, the Bernoulli numbers.

## Main theorems

- `sum_bernoulli`: The sum of the $k^\mathrm{th}$ Bernoulli polynomial with binomial
  coefficients up to `n` is `(n + 1) * X^n`.
- `polynomial.bernoulli_generating_function`: The Bernoulli polynomials act as generating functions
  for the exponential.

## TODO

- `bernoulli_eval_one_neg` : $$ B_n(1 - x) = (-1)^n B_n(x) $$

-/

noncomputable section

open BigOperators

open Nat Polynomial

open Nat Finset

namespace Polynomial

/-- The Bernoulli polynomials are defined in terms of the negative Bernoulli numbers. -/
def bernoulli (n : ℕ) : ℚ[X] :=
  ∑ i in range (n + 1), Polynomial.monomial (n - i) (bernoulli i * choose n i)
#align polynomial.bernoulli Polynomial.bernoulli

theorem bernoulli_def (n : ℕ) :
    bernoulli n = ∑ i in range (n + 1), Polynomial.monomial i (bernoulli (n - i) * choose n i) :=
  by
  rw [← sum_range_reflect, add_succ_sub_one, add_zero, bernoulli]
  apply sum_congr rfl
  rintro x hx
  rw [mem_range_succ_iff] at hx; rw [choose_symm hx, tsub_tsub_cancel_of_le hx]
#align polynomial.bernoulli_def Polynomial.bernoulli_def

/-
### examples
-/
section Examples

@[simp]
theorem bernoulli_zero : bernoulli 0 = 1 := by simp [bernoulli]
#align polynomial.bernoulli_zero Polynomial.bernoulli_zero

@[simp]
theorem bernoulli_eval_zero (n : ℕ) : (bernoulli n).eval 0 = bernoulli n :=
  by
  rw [bernoulli, eval_finset_sum, sum_range_succ]
  have : (∑ x : ℕ in range n, _root_.bernoulli x * n.choose x * 0 ^ (n - x)) = 0 :=
    by
    apply sum_eq_zero fun x hx => _
    have h : 0 < n - x := tsub_pos_of_lt (mem_range.1 hx)
    simp [h]
  simp [this]
#align polynomial.bernoulli_eval_zero Polynomial.bernoulli_eval_zero

@[simp]
theorem bernoulli_eval_one (n : ℕ) : (bernoulli n).eval 1 = bernoulli' n :=
  by
  simp only [bernoulli, eval_finset_sum]
  simp only [← succ_eq_add_one, sum_range_succ, mul_one, cast_one, choose_self,
    (_root_.bernoulli _).mul_comm, sum_bernoulli, one_pow, mul_one, eval_C, eval_monomial]
  by_cases h : n = 1
  · norm_num [h]
  · simp [h]
    exact bernoulli_eq_bernoulli'_of_ne_one h
#align polynomial.bernoulli_eval_one Polynomial.bernoulli_eval_one

end Examples

theorem derivative_bernoulli_add_one (k : ℕ) :
    (bernoulli (k + 1)).derivative = (k + 1) * bernoulli k :=
  by
  simp_rw [bernoulli, derivative_sum, derivative_monomial, Nat.sub_sub, Nat.add_sub_add_right]
  -- LHS sum has an extra term, but the coefficient is zero:
  rw [range_add_one, sum_insert not_mem_range_self, tsub_self, cast_zero, MulZeroClass.mul_zero,
    map_zero, zero_add, mul_sum]
  -- the rest of the sum is termwise equal:
  refine' sum_congr (by rfl) fun m hm => _
  conv_rhs => rw [← Nat.cast_one, ← Nat.cast_add, ← C_eq_nat_cast, C_mul_monomial, mul_comm]
  rw [mul_assoc, mul_assoc, ← Nat.cast_mul, ← Nat.cast_mul]
  congr 3
  rw [(choose_mul_succ_eq k m).symm, mul_comm]
#align polynomial.derivative_bernoulli_add_one Polynomial.derivative_bernoulli_add_one

theorem derivative_bernoulli (k : ℕ) : (bernoulli k).derivative = k * bernoulli (k - 1) :=
  by
  cases k
  · rw [Nat.cast_zero, MulZeroClass.zero_mul, bernoulli_zero, derivative_one]
  · exact_mod_cast derivative_bernoulli_add_one k
#align polynomial.derivative_bernoulli Polynomial.derivative_bernoulli

@[simp]
theorem sum_bernoulli (n : ℕ) :
    (∑ k in range (n + 1), ((n + 1).choose k : ℚ) • bernoulli k) = monomial n (n + 1 : ℚ) :=
  by
  simp_rw [bernoulli_def, Finset.smul_sum, Finset.range_eq_Ico, ← Finset.sum_Ico_Ico_comm,
    Finset.sum_Ico_eq_sum_range]
  simp only [add_tsub_cancel_left, tsub_zero, zero_add, LinearMap.map_add]
  simp_rw [smul_monomial, mul_comm (_root_.bernoulli _) _, smul_eq_mul, ← mul_assoc]
  conv_lhs =>
    apply_congr
    skip
    conv =>
      apply_congr
      skip
      rw [← Nat.cast_mul,
        choose_mul ((le_tsub_iff_left <| mem_range_le H).1 <| mem_range_le H_1) (le.intro rfl),
        Nat.cast_mul, add_comm x x_1, add_tsub_cancel_right, mul_assoc, mul_comm, ← smul_eq_mul, ←
        smul_monomial]
    rw [← sum_smul]
  rw [sum_range_succ_comm]
  simp only [add_right_eq_self, mul_one, cast_one, cast_add, add_tsub_cancel_left,
    choose_succ_self_right, one_smul, _root_.bernoulli_zero, sum_singleton, zero_add,
    LinearMap.map_add, range_one]
  apply sum_eq_zero fun x hx => _
  have f : ∀ x ∈ range n, ¬n + 1 - x = 1 := by
    rintro x H
    rw [mem_range] at H
    rw [eq_comm]
    exact ne_of_lt (Nat.lt_of_lt_of_le one_lt_two (le_tsub_of_add_le_left (succ_le_succ H)))
  rw [sum_bernoulli]
  have g : ite (n + 1 - x = 1) (1 : ℚ) 0 = 0 :=
    by
    simp only [ite_eq_right_iff, one_ne_zero]
    intro h₁
    exact (f x hx) h₁
  rw [g, zero_smul]
#align polynomial.sum_bernoulli Polynomial.sum_bernoulli

/-- Another version of `polynomial.sum_bernoulli`. -/
theorem bernoulli_eq_sub_sum (n : ℕ) :
    (n.succ : ℚ) • bernoulli n =
      monomial n (n.succ : ℚ) - ∑ k in Finset.range n, ((n + 1).choose k : ℚ) • bernoulli k :=
  by
  rw [Nat.cast_succ, ← sum_bernoulli n, sum_range_succ, add_sub_cancel', choose_succ_self_right,
    Nat.cast_succ]
#align polynomial.bernoulli_eq_sub_sum Polynomial.bernoulli_eq_sub_sum

/-- Another version of `bernoulli.sum_range_pow`. -/
theorem sum_range_pow_eq_bernoulli_sub (n p : ℕ) :
    ((p + 1 : ℚ) * ∑ k in range n, (k : ℚ) ^ p) = (bernoulli p.succ).eval n - bernoulli p.succ :=
  by
  rw [sum_range_pow, bernoulli_def, eval_finset_sum, ← sum_div, mul_div_cancel' _ _]
  · simp_rw [eval_monomial]
    symm
    rw [← sum_flip _, sum_range_succ]
    simp only [tsub_self, tsub_zero, choose_zero_right, cast_one, mul_one, pow_zero,
      add_tsub_cancel_right]
    apply sum_congr rfl fun x hx => _
    apply congr_arg₂ _ (congr_arg₂ _ _ _) rfl
    · rw [Nat.sub_sub_self (mem_range_le hx)]
    · rw [← choose_symm (mem_range_le hx)]
  · norm_cast
    apply succ_ne_zero _
#align polynomial.sum_range_pow_eq_bernoulli_sub Polynomial.sum_range_pow_eq_bernoulli_sub

/-- Rearrangement of `polynomial.sum_range_pow_eq_bernoulli_sub`. -/
theorem bernoulli_succ_eval (n p : ℕ) :
    (bernoulli p.succ).eval n = bernoulli p.succ + (p + 1 : ℚ) * ∑ k in range n, (k : ℚ) ^ p :=
  by
  apply eq_add_of_sub_eq'
  rw [sum_range_pow_eq_bernoulli_sub]
#align polynomial.bernoulli_succ_eval Polynomial.bernoulli_succ_eval

theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
    (bernoulli n).eval (1 + x) = (bernoulli n).eval x + n * x ^ (n - 1) :=
  by
  apply Nat.strong_induction_on n fun d hd => _
  have nz : ((d.succ : ℕ) : ℚ) ≠ 0 := by
    norm_cast
    exact d.succ_ne_zero
  apply (mul_right_inj' nz).1
  rw [← smul_eq_mul, ← eval_smul, bernoulli_eq_sub_sum, mul_add, ← smul_eq_mul, ← eval_smul,
    bernoulli_eq_sub_sum, eval_sub, eval_finset_sum]
  conv_lhs =>
    congr
    skip
    apply_congr
    skip
    rw [eval_smul, hd x_1 (mem_range.1 H)]
  rw [eval_sub, eval_finset_sum]
  simp_rw [eval_smul, smul_add]
  rw [sum_add_distrib, sub_add, sub_eq_sub_iff_sub_eq_sub, _root_.add_sub_sub_cancel]
  conv_rhs =>
    congr
    skip
    congr
    rw [succ_eq_add_one, ← choose_succ_self_right d]
  rw [Nat.cast_succ, ← smul_eq_mul, ← sum_range_succ _ d, eval_monomial_one_add_sub]
  simp_rw [smul_eq_mul]
#align polynomial.bernoulli_eval_one_add Polynomial.bernoulli_eval_one_add

open PowerSeries

variable {A : Type _} [CommRing A] [Algebra ℚ A]

-- TODO: define exponential generating functions, and use them here
-- This name should probably be updated afterwards
/-- The theorem that $(e^X - 1) * ∑ Bₙ(t)* X^n/n! = Xe^{tX}$ -/
theorem bernoulli_generating_function (t : A) :
    (mk fun n => aeval t ((1 / n ! : ℚ) • bernoulli n)) * (exp A - 1) =
      PowerSeries.x * rescale t (exp A) :=
  by
  -- check equality of power series by checking coefficients of X^n
  ext n
  -- n = 0 case solved by `simp`
  cases n;
  · simp
  -- n ≥ 1, the coefficients is a sum to n+2, so use `sum_range_succ` to write as
  -- last term plus sum to n+1
  rw [coeff_succ_X_mul, coeff_rescale, coeff_exp, PowerSeries.coeff_mul,
    nat.sum_antidiagonal_eq_sum_range_succ_mk, sum_range_succ]
  -- last term is zero so kill with `add_zero`
  simp only [RingHom.map_sub, tsub_self, constant_coeff_one, constant_coeff_exp,
    coeff_zero_eq_constant_coeff, MulZeroClass.mul_zero, sub_self, add_zero]
  -- Let's multiply both sides by (n+1)! (OK because it's a unit)
  have hnp1 : IsUnit ((n + 1)! : ℚ) := IsUnit.mk0 _ (by exact_mod_cast factorial_ne_zero (n + 1))
  rw [← (hnp1.map (algebraMap ℚ A)).mul_right_inj]
  -- do trivial rearrangements to make RHS (n+1)*t^n
  rw [mul_left_comm, ← RingHom.map_mul]
  change _ = t ^ n * algebraMap ℚ A (((n + 1) * n ! : ℕ) * (1 / n !))
  rw [cast_mul, mul_assoc,
    mul_one_div_cancel (show (n ! : ℚ) ≠ 0 from cast_ne_zero.2 (factorial_ne_zero n)), mul_one,
    mul_comm (t ^ n), ← aeval_monomial, cast_add, cast_one]
  -- But this is the RHS of `sum_bernoulli_poly`
  rw [← sum_bernoulli, Finset.mul_sum, AlgHom.map_sum]
  -- and now we have to prove a sum is a sum, but all the terms are equal.
  apply Finset.sum_congr rfl
  -- The rest is just trivialities, hampered by the fact that we're coercing
  -- factorials and binomial coefficients between ℕ and ℚ and A.
  intro i hi
  -- deal with coefficients of e^X-1
  simp only [Nat.cast_choose ℚ (mem_range_le hi), coeff_mk, if_neg (mem_range_sub_ne_zero hi),
    one_div, AlgHom.map_smul, PowerSeries.coeff_one, coeff_exp, sub_zero, LinearMap.map_sub,
    Algebra.smul_mul_assoc, Algebra.smul_def, mul_right_comm _ ((aeval t) _), ← mul_assoc, ←
    RingHom.map_mul, succ_eq_add_one, ← Polynomial.C_eq_algebraMap, Polynomial.aeval_mul,
    Polynomial.aeval_C]
  -- finally cancel the Bernoulli polynomial and the algebra_map
  congr
  apply congr_arg
  rw [mul_assoc, div_eq_mul_inv, ← mul_inv]
#align polynomial.bernoulli_generating_function Polynomial.bernoulli_generating_function

end Polynomial