l3lab/ntp-mathlib huggingface dataset:
/-- In a noncommutative ordered `*`-algebra over ℝ,
Tsirelson's bound for a CHSH tuple (A₀, A₁, B₀, B₁) is
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2^(3/2) • 1`.

We prove this by providing an explicit sum-of-squares decomposition
of the difference.

(We could work over `ℤ[2^(1/2), 2^(-1/2)]` if we really wanted to!)
-/
theorem tsirelson_inequality [OrderedRing R] [StarOrderedRing R] [Algebra ℝ R] [OrderedSMul ℝ R]
    [StarModule ℝ R] (A₀ A₁ B₀ B₁ : R) (T : IsCHSHTuple A₀ A₁ B₀ B₁) :
    A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ √2 ^ 3 • (1 : R) := by
  -- abel will create `ℤ` multiplication. We will `simp` them away to `ℝ` multiplication.
  have M : ∀ (m : ℤ) (a : ℝ) (x : R), m • a • x = ((m : ℝ) * a) • x := fun m a x => by
    rw [zsmul_eq_smul_cast ℝ, ← mul_smul]
  let P := √2⁻¹ • (A₁ + A₀) - B₀
  let Q := √2⁻¹ • (A₁ - A₀) + B₁
  have w : √2 ^ 3 • (1 : R) - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁ = √2⁻¹ • (P ^ 2 + Q ^ 2) := by
    dsimp
    -- distribute out all the powers and products appearing on the RHS
    simp only [sq, sub_mul, mul_sub, add_mul, mul_add, smul_add, smul_sub]
    -- pull all coefficients out to the front, and combine `√2`s where possible
    simp only [Algebra.mul_smul_comm, Algebra.smul_mul_assoc, ← mul_smul, sqrt_two_inv_mul_self]
    -- replace Aᵢ * Aᵢ = 1 and Bᵢ * Bᵢ = 1
    simp only [← sq, T.A₀_inv, T.A₁_inv, T.B₀_inv, T.B₁_inv]
    -- move Aᵢ to the left of Bᵢ
    simp only [← T.A₀B₀_commutes, ← T.A₀B₁_commutes, ← T.A₁B₀_commutes, ← T.A₁B₁_commutes]
    -- collect terms, simplify coefficients, and collect terms again:
    abel_nf
    -- all terms coincide, but the last one. Simplify all other terms
    simp only [M]
    simp only [neg_mul, one_mul, mul_inv_cancel_of_invertible, Int.cast_one, add_assoc, add_comm,
      add_left_comm, one_smul, Int.cast_neg, neg_smul, Int.int_cast_ofNat]
    simp only [← add_assoc, ← add_smul]
    -- just look at the coefficients now:
    congr
    exact mul_left_cancel₀ (by norm_num) tsirelson_inequality_aux
  have pos : 0 ≤ √2⁻¹ • (P ^ 2 + Q ^ 2) := by
    have P_sa : star P = P := by
      simp only [star_smul, star_add, star_sub, star_id_of_comm, T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa]
    have Q_sa : star Q = Q := by
      simp only [star_smul, star_add, star_sub, star_id_of_comm, T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa]
    have P2_nonneg : 0 ≤ P ^ 2 := by
      rw [sq]
      conv =>
        congr
        skip
        congr
        rw [← P_sa]
      convert (star_mul_self_nonneg P)
    have Q2_nonneg : 0 ≤ Q ^ 2 := by
      rw [sq]
      conv =>
        congr
        skip
        congr
        rw [← Q_sa]
      

Proof state:
R : Type u
inst✝⁴ : OrderedRing R
inst✝³ : StarOrderedRing R
inst✝² : Algebra ℝ R
inst✝¹ : OrderedSMul ℝ R
inst✝ : StarModule ℝ R
A₀ A₁ B₀ B₁ : R
T : IsCHSHTuple A₀ A₁ B₀ B₁
M : ∀ (m : ℤ) (a : ℝ) (x : R), m • a • x = (↑m * a) • x
P : R := (Real.sqrt 2)⁻¹ • (A₁ + A₀) - B₀
Q : R := (Real.sqrt 2)⁻¹ • (A₁ - A₀) + B₁
w : Real.sqrt 2 ^ 3 • 1 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁ = (Real.sqrt 2)⁻¹ • (P ^ 2 + Q ^ 2)
P_sa : star P = P
Q_sa : star Q = Q
P2_nonneg : 0 ≤ P ^ 2
⊢ 0 ≤ star Q * star Q

Next tactic:
convert (star_mul_self_nonneg Q)
@[simp] lemma covby_cons (s : Multiset α) (a : α) : s ⋖ a ::ₘ s :=
  ⟨lt_cons_self _ _, fun t hst hts ↦ (covby_succ _).2 (card_lt_of_lt hst) $ by
    

Proof state:
α : Type u_1
s✝ t✝ : Multiset α
a✝ : α
s : Multiset α
a : α
t : Multiset α
hst : s < t
hts : t < a ::ₘ s
⊢ card t < succ (card s)

Next tactic:
simpa using card_lt_of_lt hts
lemma covby_iff : s ⋖ t ↔ ∃ a, a ::ₘ s = t :=
  ⟨Covby.exists_multiset_cons, by 

Proof state:
α : Type u_1
s t : Multiset α
a : α
⊢ (∃ a, a ::ₘ s = t) → s ⋖ t

Next tactic:
rintro ⟨a, rfl⟩
lemma covby_iff : s ⋖ t ↔ ∃ a, a ::ₘ s = t :=
  ⟨Covby.exists_multiset_cons, by rintro ⟨a, rfl⟩; 

Proof state:
case intro
α : Type u_1
s : Multiset α
a✝ a : α
⊢ s ⋖ a ::ₘ s

Next tactic:
exact covby_cons _ _
lemma _root_.Covby.card_multiset (h : s ⋖ t) : card s ⋖ card t := by
  

Proof state:
α : Type u_1
s t : Multiset α
a : α
h : s ⋖ t
⊢ card s ⋖ card t

Next tactic:
obtain ⟨a, rfl⟩ := h.exists_multiset_cons
lemma _root_.Covby.card_multiset (h : s ⋖ t) : card s ⋖ card t := by
  obtain ⟨a, rfl⟩ := h.exists_multiset_cons; 

Proof state:
case intro
α : Type u_1
s : Multiset α
a✝ a : α
h : s ⋖ a ::ₘ s
⊢ card s ⋖ card (a ::ₘ s)

Next tactic:
rw [card_cons]
lemma _root_.Covby.card_multiset (h : s ⋖ t) : card s ⋖ card t := by
  obtain ⟨a, rfl⟩ := h.exists_multiset_cons; rw [card_cons]; 

Proof state:
case intro
α : Type u_1
s : Multiset α
a✝ a : α
h : s ⋖ a ::ₘ s
⊢ card s ⋖ card s + 1

Next tactic:
exact covby_succ _
lemma isAtom_iff : IsAtom s ↔ ∃ a, s = {a} := by 

Proof state:
α : Type u_1
s t : Multiset α
a : α
⊢ IsAtom s ↔ ∃ a, s = {a}

Next tactic:
simp [← bot_covby_iff, covby_iff, eq_comm]
instance instGradeMinOrder : GradeMinOrder ℕ (Multiset α) where
  grade := card
  grade_strictMono := card_strictMono
  covby_grade s t := Covby.card_multiset
  isMin_grade s hs := by 

Proof state:
α : Type u_1
s✝ t : Multiset α
a : α
s : Multiset α
hs : IsMin s
⊢ IsMin (GradeOrder.grade s)

Next tactic:
rw [isMin_iff_eq_bot.1 hs]
instance instGradeMinOrder : GradeMinOrder ℕ (Multiset α) where
  grade := card
  grade_strictMono := card_strictMono
  covby_grade s t := Covby.card_multiset
  isMin_grade s hs := by rw [isMin_iff_eq_bot.1 hs]; 

Proof state:
α : Type u_1
s✝ t : Multiset α
a : α
s : Multiset α
hs : IsMin s
⊢ IsMin (GradeOrder.grade ⊥)

Next tactic:
exact isMin_bot
/-- Finsets form an order-connected suborder of multisets. -/
lemma ordConnected_range_val : Set.OrdConnected (Set.range val : Set $ Multiset α) :=
  ⟨by 

Proof state:
α : Type u_1
s t : Finset α
a : α
⊢ ∀ ⦃x : Multiset α⦄, x ∈ Set.range val → ∀ ⦃y : Multiset α⦄, y ∈ Set.range val → Set.Icc x y ⊆ Set.range val

Next tactic:
rintro _ _ _ ⟨s, rfl⟩ t ht
/-- Finsets form an order-connected suborder of multisets. -/
lemma ordConnected_range_val : Set.OrdConnected (Set.range val : Set $ Multiset α) :=
  ⟨by rintro _ _ _ ⟨s, rfl⟩ t ht; 

Proof state:
case intro
α : Type u_1
s✝ t✝ : Finset α
a : α
x✝ : Multiset α
hx✝ : x✝ ∈ Set.range val
s : Finset α
t : Multiset α
ht : t ∈ Set.Icc x✝ s.val
⊢ t ∈ Set.range val

Next tactic:
exact ⟨⟨t, Multiset.nodup_of_le ht.2 s.2⟩, rfl⟩
/-- Finsets form an order-connected suborder of sets. -/
lemma ordConnected_range_coe : Set.OrdConnected (Set.range ((↑) : Finset α → Set α)) :=
  ⟨by 

Proof state:
α : Type u_1
s t : Finset α
a : α
⊢ ∀ ⦃x : Set α⦄, x ∈ Set.range toSet → ∀ ⦃y : Set α⦄, y ∈ Set.range toSet → Set.Icc x y ⊆ Set.range toSet

Next tactic:
rintro _ _ _ ⟨s, rfl⟩ t ht
/-- Finsets form an order-connected suborder of sets. -/
lemma ordConnected_range_coe : Set.OrdConnected (Set.range ((↑) : Finset α → Set α)) :=
  ⟨by rintro _ _ _ ⟨s, rfl⟩ t ht; 

Proof state:
case intro
α : Type u_1
s✝ t✝ : Finset α
a : α
x✝ : Set α
hx✝ : x✝ ∈ Set.range toSet
s : Finset α
t : Set α
ht : t ∈ Set.Icc x✝ ↑s
⊢ t ∈ Set.range toSet

Next tactic:
exact ⟨_, (s.finite_toSet.subset ht.2).coe_toFinset⟩
@[simp] lemma covby_cons (ha : a ∉ s) : s ⋖ s.cons a ha := by 

Proof state:
α : Type u_1
s t : Finset α
a : α
ha : a ∉ s
⊢ s ⋖ cons a s ha

Next tactic:
simp [← val_covby_val]
lemma covby_iff_exists_cons : s ⋖ t ↔ ∃ a, ∃ ha : a ∉ s, s.cons a ha = t :=
  ⟨Covby.exists_finset_cons, by 

Proof state:
α : Type u_1
s t : Finset α
a : α
⊢ (∃ a, ∃ (ha : a ∉ s), cons a s ha = t) → s ⋖ t

Next tactic:
rintro ⟨a, ha, rfl⟩
lemma covby_iff_exists_cons : s ⋖ t ↔ ∃ a, ∃ ha : a ∉ s, s.cons a ha = t :=
  ⟨Covby.exists_finset_cons, by rintro ⟨a, ha, rfl⟩; 

Proof state:
case intro.intro
α : Type u_1
s : Finset α
a✝ a : α
ha : a ∉ s
⊢ s ⋖ cons a s ha

Next tactic:
exact covby_cons _
@[simp] lemma wcovby_insert (s : Finset α) (a : α) : s ⩿ insert a s := by 

Proof state:
α : Type u_1
s✝ t : Finset α
a✝ : α
inst✝ : DecidableEq α
s : Finset α
a : α
⊢ s ⩿ insert a s

Next tactic:
simp [← coe_wcovby_coe]
@[simp] lemma erase_wcovby (s : Finset α) (a : α) : s.erase a ⩿ s := by 

Proof state:
α : Type u_1
s✝ t : Finset α
a✝ : α
inst✝ : DecidableEq α
s : Finset α
a : α
⊢ erase s a ⩿ s

Next tactic:
simp [← coe_wcovby_coe]
lemma _root_.Covby.exists_finset_insert (h : s ⋖ t) : ∃ a ∉ s, insert a s = t := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
h : s ⋖ t
⊢ ∃ a ∉ s, insert a s = t

Next tactic:
simpa using h.exists_finset_cons
lemma _root_.Covby.exists_finset_erase (h : s ⋖ t) : ∃ a ∈ t, t.erase a = s := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
h : s ⋖ t
⊢ ∃ a ∈ t, erase t a = s

Next tactic:
simpa only [← coe_inj, coe_erase] using h.finset_coe.exists_set_sdiff_singleton
lemma covby_iff_exists_insert : s ⋖ t ↔ ∃ a ∉ s, insert a s = t := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ s ⋖ t ↔ ∃ a ∉ s, insert a s = t

Next tactic:
simp only [← coe_covby_coe, Set.covby_iff_exists_insert, ← coe_inj, coe_insert, mem_coe]
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ t ⋖ s ↔ t ⊆ s ∧ card (s \ t) = 1

Next tactic:
rw [covby_iff_exists_insert]
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ (∃ a ∉ t, insert a t = s) ↔ t ⊆ s ∧ card (s \ t) = 1

Next tactic:
constructor
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  constructor
  · 

Proof state:
case mp
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ (∃ a ∉ t, insert a t = s) → t ⊆ s ∧ card (s \ t) = 1

Next tactic:
rintro ⟨a, ha, rfl⟩
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  constructor
  · rintro ⟨a, ha, rfl⟩
    

Proof state:
case mp.intro.intro
α : Type u_1
t : Finset α
a✝ : α
inst✝ : DecidableEq α
a : α
ha : a ∉ t
⊢ t ⊆ insert a t ∧ card (insert a t \ t) = 1

Next tactic:
simp [*]
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  constructor
  · rintro ⟨a, ha, rfl⟩
    simp [*]
  · 

Proof state:
case mpr
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ t ⊆ s ∧ card (s \ t) = 1 → ∃ a ∉ t, insert a t = s

Next tactic:
simp_rw [card_eq_one]
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  constructor
  · rintro ⟨a, ha, rfl⟩
    simp [*]
  · simp_rw [card_eq_one]
    

Proof state:
case mpr
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ (t ⊆ s ∧ ∃ a, s \ t = {a}) → ∃ a ∉ t, insert a t = s

Next tactic:
rintro ⟨hts, a, ha⟩
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  constructor
  · rintro ⟨a, ha, rfl⟩
    simp [*]
  · simp_rw [card_eq_one]
    rintro ⟨hts, a, ha⟩
    

Proof state:
case mpr.intro.intro
α : Type u_1
s t : Finset α
a✝ : α
inst✝ : DecidableEq α
hts : t ⊆ s
a : α
ha : s \ t = {a}
⊢ ∃ a ∉ t, insert a t = s

Next tactic:
refine ⟨a, (mem_sdiff.1 $ superset_of_eq ha $ mem_singleton_self _).2, ?_⟩
lemma covby_iff_card_sdiff_eq_one : t ⋖ s ↔ t ⊆ s ∧ (s \ t).card = 1 := by
  rw [covby_iff_exists_insert]
  constructor
  · rintro ⟨a, ha, rfl⟩
    simp [*]
  · simp_rw [card_eq_one]
    rintro ⟨hts, a, ha⟩
    refine ⟨a, (mem_sdiff.1 $ superset_of_eq ha $ mem_singleton_self _).2, ?_⟩
    

Proof state:
case mpr.intro.intro
α : Type u_1
s t : Finset α
a✝ : α
inst✝ : DecidableEq α
hts : t ⊆ s
a : α
ha : s \ t = {a}
⊢ insert a t = s

Next tactic:
rw [insert_eq, ← ha, sdiff_union_of_subset hts]
lemma covby_iff_exists_erase : s ⋖ t ↔ ∃ a ∈ t, t.erase a = s := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝ : DecidableEq α
⊢ s ⋖ t ↔ ∃ a ∈ t, erase t a = s

Next tactic:
simp only [← coe_covby_coe, Set.covby_iff_exists_sdiff_singleton, ← coe_inj, coe_erase, mem_coe]
protected lemma isAtom_iff : IsAtom s ↔ ∃ a, s = {a} := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
⊢ IsAtom s ↔ ∃ a, s = {a}

Next tactic:
simp [← bot_covby_iff, covby_iff_exists_cons, eq_comm]
protected lemma isCoatom_iff : IsCoatom s ↔ ∃ a, s = {a}ᶜ := by
  

Proof state:
α : Type u_1
s t : Finset α
a : α
inst✝¹ : Fintype α
inst✝ : DecidableEq α
⊢ IsCoatom s ↔ ∃ a, s = {a}ᶜ

Next tactic:
simp_rw [← isAtom_compl, Finset.isAtom_iff, compl_eq_iff_isCompl, eq_compl_iff_isCompl]
/-- Finsets are multiset-graded. This is not very meaningful mathematically but rather a handy way
to record that the inclusion `Finset α ↪ Multiset α` preserves the covering relation. -/
instance instGradeMinOrder_multiset : GradeMinOrder (Multiset α) (Finset α) where
  grade := val
  grade_strictMono := val_strictMono
  covby_grade _ _ := Covby.finset_val
  isMin_grade s hs := by 

Proof state:
α : Type u_1
s✝ t : Finset α
a : α
s : Finset α
hs : IsMin s
⊢ IsMin (GradeOrder.grade s)

Next tactic:
rw [isMin_iff_eq_bot.1 hs]
/-- Finsets are multiset-graded. This is not very meaningful mathematically but rather a handy way
to record that the inclusion `Finset α ↪ Multiset α` preserves the covering relation. -/
instance instGradeMinOrder_multiset : GradeMinOrder (Multiset α) (Finset α) where
  grade := val
  grade_strictMono := val_strictMono
  covby_grade _ _ := Covby.finset_val
  isMin_grade s hs := by rw [isMin_iff_eq_bot.1 hs]; 

Proof state:
α : Type u_1
s✝ t : Finset α
a : α
s : Finset α
hs : IsMin s
⊢ IsMin (GradeOrder.grade ⊥)

Next tactic:
exact isMin_bot
instance instGradeMinOrder_nat : GradeMinOrder ℕ (Finset α) where
  grade := card
  grade_strictMono := card_strictMono
  covby_grade _ _ := Covby.card_finset
  isMin_grade s hs := by 

Proof state:
α : Type u_1
s✝ t : Finset α
a : α
s : Finset α
hs : IsMin s
⊢ IsMin (GradeOrder.grade s)

Next tactic:
rw [isMin_iff_eq_bot.1 hs]
instance instGradeMinOrder_nat : GradeMinOrder ℕ (Finset α) where
  grade := card
  grade_strictMono := card_strictMono
  covby_grade _ _ := Covby.card_finset
  isMin_grade s hs := by rw [isMin_iff_eq_bot.1 hs]; 

Proof state:
α : Type u_1
s✝ t : Finset α
a : α
s : Finset α
hs : IsMin s
⊢ IsMin (GradeOrder.grade ⊥)

Next tactic:
exact isMin_bot
/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
theorem bubble_sort_induction' {n : ℕ} {α : Type*} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h : ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
      i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ Equiv.swap i j)) :
    P (f ∘ sort f) := by
  

Proof state:
n : ℕ
α : Type u_1
inst✝ : LinearOrder α
f : Fin n → α
P : (Fin n → α) → Prop
hf : P f
h :
  ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
    i < j → (f ∘ ⇑σ) j < (f ∘ ⇑σ) i → P (f ∘ ⇑σ) → P (f ∘ ⇑σ ∘ ⇑(Equiv.swap i j))
⊢ P (f ∘ ⇑(sort f))

Next tactic:
letI := @Preorder.lift _ (Lex (Fin n → α)) _ fun σ : Equiv.Perm (Fin n) => toLex (f ∘ σ)
/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
theorem bubble_sort_induction' {n : ℕ} {α : Type*} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h : ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
      i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ Equiv.swap i j)) :
    P (f ∘ sort f) := by
  letI := @Preorder.lift _ (Lex (Fin n → α)) _ fun σ : Equiv.Perm (Fin n) => toLex (f ∘ σ)
  

Proof state:
n : ℕ
α : Type u_1
inst✝ : LinearOrder α
f : Fin n → α
P : (Fin n → α) → Prop
hf : P f
h :
  ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
    i < j → (f ∘ ⇑σ) j < (f ∘ ⇑σ) i → P (f ∘ ⇑σ) → P (f ∘ ⇑σ ∘ ⇑(Equiv.swap i j))
this : Preorder (Equiv.Perm (Fin n)) := Preorder.lift fun σ => toLex (f ∘ ⇑σ)
⊢ P (f ∘ ⇑(sort f))

Next tactic:
refine'
    @WellFounded.induction_bot' _ _ _ (IsWellFounded.wf : WellFounded (· < ·))
      (Equiv.refl _) (sort f) P (fun σ => f ∘ σ) (fun σ hσ hfσ => _) hf
/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
theorem bubble_sort_induction' {n : ℕ} {α : Type*} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h : ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
      i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ Equiv.swap i j)) :
    P (f ∘ sort f) := by
  letI := @Preorder.lift _ (Lex (Fin n → α)) _ fun σ : Equiv.Perm (Fin n) => toLex (f ∘ σ)
  refine'
    @WellFounded.induction_bot' _ _ _ (IsWellFounded.wf : WellFounded (· < ·))
      (Equiv.refl _) (sort f) P (fun σ => f ∘ σ) (fun σ hσ hfσ => _) hf
  

Proof state:
n : ℕ
α : Type u_1
inst✝ : LinearOrder α
f : Fin n → α
P : (Fin n → α) → Prop
hf : P f
h :
  ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
    i < j → (f ∘ ⇑σ) j < (f ∘ ⇑σ) i → P (f ∘ ⇑σ) → P (f ∘ ⇑σ ∘ ⇑(Equiv.swap i j))
this : Preorder (Equiv.Perm (Fin n)) := Preorder.lift fun σ => toLex (f ∘ ⇑σ)
σ : Fin n ≃ Fin n
hσ : (fun σ => f ∘ ⇑σ) σ ≠ (fun σ => f ∘ ⇑σ) (sort f)
hfσ : P ((fun σ => f ∘ ⇑σ) σ)
⊢ ∃ c < σ, P ((fun σ => f ∘ ⇑σ) c)

Next tactic:
obtain ⟨i, j, hij₁, hij₂⟩ := antitone_pair_of_not_sorted' hσ
/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
theorem bubble_sort_induction' {n : ℕ} {α : Type*} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h : ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
      i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ Equiv.swap i j)) :
    P (f ∘ sort f) := by
  letI := @Preorder.lift _ (Lex (Fin n → α)) _ fun σ : Equiv.Perm (Fin n) => toLex (f ∘ σ)
  refine'
    @WellFounded.induction_bot' _ _ _ (IsWellFounded.wf : WellFounded (· < ·))
      (Equiv.refl _) (sort f) P (fun σ => f ∘ σ) (fun σ hσ hfσ => _) hf
  obtain ⟨i, j, hij₁, hij₂⟩ := antitone_pair_of_not_sorted' hσ
  

Proof state:
case intro.intro.intro
n : ℕ
α : Type u_1
inst✝ : LinearOrder α
f : Fin n → α
P : (Fin n → α) → Prop
hf : P f
h :
  ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
    i < j → (f ∘ ⇑σ) j < (f ∘ ⇑σ) i → P (f ∘ ⇑σ) → P (f ∘ ⇑σ ∘ ⇑(Equiv.swap i j))
this : Preorder (Equiv.Perm (Fin n)) := Preorder.lift fun σ => toLex (f ∘ ⇑σ)
σ : Fin n ≃ Fin n
hσ : (fun σ => f ∘ ⇑σ) σ ≠ (fun σ => f ∘ ⇑σ) (sort f)
hfσ : P ((fun σ => f ∘ ⇑σ) σ)
i j : Fin n
hij₁ : i < j
hij₂ : (f ∘ ⇑σ) j < (f ∘ ⇑σ) i
⊢ ∃ c < σ, P ((fun σ => f ∘ ⇑σ) c)

Next tactic:
exact ⟨σ * Equiv.swap i j, Pi.lex_desc hij₁.le hij₂, h σ i j hij₁ hij₂ hfσ⟩
theorem uncurry_id_eq_ev (A X : C) [Exponentiable A] : uncurry (𝟙 (A ⟹ X)) = (exp.ev A).app X := by
  

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A✝ B X✝ X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A✝
A X : C
inst✝ : Exponentiable A
⊢ uncurry (𝟙 (A ⟹ X)) = (exp.ev A).app X

Next tactic:
rw [uncurry_eq, prod.map_id_id, id_comp]
theorem curry_id_eq_coev (A X : C) [Exponentiable A] : curry (𝟙 _) = (exp.coev A).app X := by
  

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A✝ B X✝ X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A✝
A X : C
inst✝ : Exponentiable A
⊢ curry (𝟙 (A ⨯ (𝟭 C).obj X)) = (exp.coev A).app X

Next tactic:
rw [curry_eq, (exp A).map_id (A ⨯ _)]
theorem curry_id_eq_coev (A X : C) [Exponentiable A] : curry (𝟙 _) = (exp.coev A).app X := by
  rw [curry_eq, (exp A).map_id (A ⨯ _)]; 

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A✝ B X✝ X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A✝
A X : C
inst✝ : Exponentiable A
⊢ (exp.coev A).app ((𝟭 C).obj X) ≫ 𝟙 (A ⟹ A ⨯ (𝟭 C).obj X) = (exp.coev A).app X

Next tactic:
apply comp_id
/-- Show that the exponential of the terminal object is isomorphic to itself, i.e. `X^1 ≅ X`.

The typeclass argument is explicit: any instance can be used.
-/
def expTerminalIsoSelf [Exponentiable (⊤_ C)] : (⊤_ C) ⟹ X ≅ X :=
  Yoneda.ext ((⊤_ C) ⟹ X) X
    (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f)
    (fun {Y} f => CartesianClosed.curry ((prod.leftUnitor Y).hom ≫ f))
    (fun g => by
      

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A B X X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A
inst✝ : Exponentiable (⊤_ C)
Z✝ : C
g : Z✝ ⟶ (⊤_ C) ⟹ X
⊢ (fun {Y} f => CartesianClosed.curry ((prod.leftUnitor Y).hom ≫ f))
      ((fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f) g) =
    g

Next tactic:
rw [curry_eq_iff, Iso.hom_inv_id_assoc]
/-- Show that the exponential of the terminal object is isomorphic to itself, i.e. `X^1 ≅ X`.

The typeclass argument is explicit: any instance can be used.
-/
def expTerminalIsoSelf [Exponentiable (⊤_ C)] : (⊤_ C) ⟹ X ≅ X :=
  Yoneda.ext ((⊤_ C) ⟹ X) X
    (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f)
    (fun {Y} f => CartesianClosed.curry ((prod.leftUnitor Y).hom ≫ f))
    (fun g => by
      rw [curry_eq_iff, Iso.hom_inv_id_assoc])
    (fun g => by 

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A B X X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A
inst✝ : Exponentiable (⊤_ C)
Z✝ : C
g : Z✝ ⟶ X
⊢ (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f)
      ((fun {Y} f => CartesianClosed.curry ((prod.leftUnitor Y).hom ≫ f)) g) =
    g

Next tactic:
simp
/-- Show that the exponential of the terminal object is isomorphic to itself, i.e. `X^1 ≅ X`.

The typeclass argument is explicit: any instance can be used.
-/
def expTerminalIsoSelf [Exponentiable (⊤_ C)] : (⊤_ C) ⟹ X ≅ X :=
  Yoneda.ext ((⊤_ C) ⟹ X) X
    (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f)
    (fun {Y} f => CartesianClosed.curry ((prod.leftUnitor Y).hom ≫ f))
    (fun g => by
      rw [curry_eq_iff, Iso.hom_inv_id_assoc])
    (fun g => by simp)
    (fun f g => by
      -- Porting note: `rw` is a bit brittle here, requiring the `dsimp` rule cancellation.
      

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A B X X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A
inst✝ : Exponentiable (⊤_ C)
Z✝ Z'✝ : C
f : Z'✝ ⟶ Z✝
g : Z✝ ⟶ (⊤_ C) ⟹ X
⊢ (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f) (f ≫ g) =
    f ≫ (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f) g

Next tactic:
dsimp [-prod.leftUnitor_inv]
/-- Show that the exponential of the terminal object is isomorphic to itself, i.e. `X^1 ≅ X`.

The typeclass argument is explicit: any instance can be used.
-/
def expTerminalIsoSelf [Exponentiable (⊤_ C)] : (⊤_ C) ⟹ X ≅ X :=
  Yoneda.ext ((⊤_ C) ⟹ X) X
    (fun {Y} f => (prod.leftUnitor Y).inv ≫ CartesianClosed.uncurry f)
    (fun {Y} f => CartesianClosed.curry ((prod.leftUnitor Y).hom ≫ f))
    (fun g => by
      rw [curry_eq_iff, Iso.hom_inv_id_assoc])
    (fun g => by simp)
    (fun f g => by
      -- Porting note: `rw` is a bit brittle here, requiring the `dsimp` rule cancellation.
      dsimp [-prod.leftUnitor_inv]
      

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A B X X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A
inst✝ : Exponentiable (⊤_ C)
Z✝ Z'✝ : C
f : Z'✝ ⟶ Z✝
g : Z✝ ⟶ (⊤_ C) ⟹ X
⊢ (prod.leftUnitor Z'✝).inv ≫ CartesianClosed.uncurry (f ≫ g) = f ≫ (prod.leftUnitor Z✝).inv ≫ CartesianClosed.uncurry g

Next tactic:
rw [uncurry_natural_left, prod.leftUnitor_inv_naturality_assoc f]
theorem uncurry_pre (f : B ⟶ A) [Exponentiable B] (X : C) :
    CartesianClosed.uncurry ((pre f).app X) = Limits.prod.map f (𝟙 _) ≫ (exp.ev A).app X := by
  

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A B X✝ X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A
f : B ⟶ A
inst✝ : Exponentiable B
X : C
⊢ CartesianClosed.uncurry ((pre f).app X) = prod.map f (𝟙 (A ⟹ X)) ≫ (exp.ev A).app X

Next tactic:
rw [uncurry_eq, prod_map_pre_app_comp_ev]
@[simp]
theorem pre_id (A : C) [Exponentiable A] : pre (𝟙 A) = 𝟙 _ := by 

Proof state:
C : Type u
inst✝³ : Category.{v, u} C
A✝ B X X' Y Y' Z : C
inst✝² : HasFiniteProducts C
inst✝¹ : Exponentiable A✝
A : C
inst✝ : Exponentiable A
⊢ pre (𝟙 A) = 𝟙 (exp A)

Next tactic:
simp [pre]