Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

chore: golf a bit #293

Merged
merged 18 commits into from
Jan 23, 2025
Merged
36 changes: 10 additions & 26 deletions HepLean/AnomalyCancellation/MSSMNu/OrthogY3B3/ToSols.lean
Original file line number Diff line number Diff line change
Expand Up @@ -286,11 +286,8 @@ lemma inLineEqToSol_proj (T : InLineEqSol) : inLineEqToSol (inLineEqProj T) = T.
/-- Given an element of `inQuad × ℚ × ℚ × ℚ`, a solution to the ACCs. -/
def inQuadToSol : InQuad × ℚ × ℚ × ℚ → MSSMACC.Sols := fun (R, a₁, a₂, a₃) =>
AnomalyFreeMk' (lineCube R.val.val a₁ a₂ a₃)
(by
erw [planeY₃B₃_quad]
rw [R.prop.1, R.prop.2.1, R.prop.2.2]
simp)
(lineCube_cube R.val.val a₁ a₂ a₃)
(by erw [planeY₃B₃_quad, R.prop.1, R.prop.2.1, R.prop.2.2]; simp)
(lineCube_cube R.val.val a₁ a₂ a₃)

lemma inQuadToSol_smul (R : InQuad) (c₁ c₂ c₃ d : ℚ) :
inQuadToSol (R, (d * c₁), (d * c₂), (d * c₃)) = d • inQuadToSol (R, c₁, c₂, c₃) := by
Expand All @@ -314,9 +311,7 @@ lemma inQuadToSol_proj (T : InQuadSol) : inQuadToSol (inQuadProj T) = T.val := b
rw [inQuadProj, inQuadToSol_smul]
apply ACCSystem.Sols.ext
change _ • (planeY₃B₃ _ _ _ _).val = _
rw [planeY₃B₃_val]
rw [Y₃_plus_B₃_plus_proj]
rw [cube_proj, cube_proj_proj_B₃, cube_proj_proj_Y₃]
rw [planeY₃B₃_val, Y₃_plus_B₃_plus_proj, cube_proj, cube_proj_proj_B₃, cube_proj_proj_Y₃]
ring_nf
simp only [zero_smul, add_zero, Fin.isValue, Fin.reduceFinMk, zero_add]
have h1 : (cubeTriLin T.val.val T.val.val Y₃.val ^ 2 * dot Y₃.val B₃.val ^ 3 * 3 +
Expand All @@ -331,14 +326,8 @@ lemma inQuadToSol_proj (T : InQuadSol) : inQuadToSol (inQuadProj T) = T.val := b
/-- Given a element of `inQuadCube × ℚ × ℚ × ℚ`, a solution to the ACCs. -/
def inQuadCubeToSol : InQuadCube × ℚ × ℚ × ℚ → MSSMACC.Sols := fun (R, b₁, b₂, b₃) =>
AnomalyFreeMk' (planeY₃B₃ R.val.val.val b₁ b₂ b₃)
(by
rw [planeY₃B₃_quad]
rw [R.val.prop.1, R.val.prop.2.1, R.val.prop.2.2]
simp)
(by
rw [planeY₃B₃_cubic]
rw [R.prop.1, R.prop.2.1, R.prop.2.2]
simp)
(by rw [planeY₃B₃_quad, R.val.prop.1, R.val.prop.2.1, R.val.prop.2.2]; simp)
(by rw [planeY₃B₃_cubic, R.prop.1, R.prop.2.1, R.prop.2.2]; simp)

lemma inQuadCubeToSol_smul (R : InQuadCube) (c₁ c₂ c₃ d : ℚ) :
inQuadCubeToSol (R, (d * c₁), (d * c₂), (d * c₃)) = d • inQuadCubeToSol (R, c₁, c₂, c₃) := by
Expand All @@ -361,8 +350,7 @@ lemma inQuadCubeToSol_proj (T : InQuadCubeSol) :
rw [inQuadCubeProj, inQuadCubeToSol_smul]
apply ACCSystem.Sols.ext
change _ • (planeY₃B₃ _ _ _ _).val = _
rw [planeY₃B₃_val]
rw [Y₃_plus_B₃_plus_proj]
rw [planeY₃B₃_val, Y₃_plus_B₃_plus_proj]
ring_nf
simp only [Fin.isValue, Fin.reduceFinMk, zero_smul, add_zero, zero_add]
rw [← MulAction.mul_smul, mul_comm, mul_inv_cancel₀]
Expand All @@ -389,17 +377,15 @@ lemma toSol_toSolNSProj (T : NotInLineEqSol) :
use toSolNSProj T.val
have h1 : ¬ LineEqProp (toSolNSProj T.val).1 :=
(linEqPropSol_iff_proj_linEqProp T.val).mpr.mt T.prop
rw [toSol]
simp_all
simp_rw [toSol, h1]
exact toSolNS_proj T

lemma toSol_inLineEq (T : InLineEqSol) : ∃ X, toSol X = T.val := by
let X := inLineEqProj T
use ⟨X.1.val, X.2.1, X.2.2⟩
have : ¬ InQuadProp X.1.val := (inQuadSolProp_iff_proj_inQuadProp T.val).mpr.mt T.prop.2
have : LineEqProp X.1.val := (linEqPropSol_iff_proj_linEqProp T.val).mp T.prop.1
rw [toSol]
simp_all
simp_all only [toSol]
exact inLineEqToSol_proj T

lemma toSol_inQuad (T : InQuadSol) : ∃ X, toSol X = T.val := by
Expand All @@ -408,8 +394,7 @@ lemma toSol_inQuad (T : InQuadSol) : ∃ X, toSol X = T.val := by
have : ¬ InCubeProp X.1.val.val := (inCubeSolProp_iff_proj_inCubeProp T.val).mpr.mt T.prop.2.2
have : InQuadProp X.1.val.val := (inQuadSolProp_iff_proj_inQuadProp T.val).mp T.prop.2.1
have : LineEqProp X.1.val.val := (linEqPropSol_iff_proj_linEqProp T.val).mp T.prop.1
rw [toSol]
simp_all
simp_all only [toSol]
exact inQuadToSol_proj T

lemma toSol_inQuadCube (T : InQuadCubeSol) : ∃ X, toSol X = T.val := by
Expand All @@ -418,8 +403,7 @@ lemma toSol_inQuadCube (T : InQuadCubeSol) : ∃ X, toSol X = T.val := by
have : InCubeProp X.1.val.val.val := (inCubeSolProp_iff_proj_inCubeProp T.val).mp T.prop.2.2
have : InQuadProp X.1.val.val.val := (inQuadSolProp_iff_proj_inQuadProp T.val).mp T.prop.2.1
have : LineEqProp X.1.val.val.val := (linEqPropSol_iff_proj_linEqProp T.val).mp T.prop.1
rw [toSol]
simp_all
simp_all only [toSol]
exact inQuadCubeToSol_proj T

theorem toSol_surjective : Function.Surjective toSol := by
Expand Down
2 changes: 1 addition & 1 deletion HepLean/AnomalyCancellation/PureU1/Even/LineInCubic.lean
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ)).LinSols}
rw [P_P_P!_accCube' g f hfg] at h1
simp only [Nat.succ_eq_add_one, neg_add_rev, mul_eq_zero] at h1
cases h1 <;> rename_i h1
· apply Or.inl
· left
linear_combination h1
· cases h1 <;> rename_i h1
· refine Or.inr (Or.inl ?_)
Expand Down
2 changes: 1 addition & 1 deletion HepLean/AnomalyCancellation/PureU1/Odd/LineInCubic.lean
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,7 @@ lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ+1)).LinSols}
rw [P_P_P!_accCube' g f hfg] at h1
simp only [Nat.succ_eq_add_one, mul_eq_zero] at h1
cases h1 <;> rename_i h1
· apply Or.inl
· left
linear_combination h1
· cases h1 <;> rename_i h1
· refine Or.inr (Or.inl ?_)
Expand Down
2 changes: 1 addition & 1 deletion HepLean/BeyondTheStandardModel/TwoHDM/Basic.lean
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ lemma swap_fields : P.toFun Φ1 Φ2 =
normSq_apply_im_zero, mul_zero, zero_add, RingHomCompTriple.comp_apply, RingHom.id_apply]
ring_nf
simp only [one_div, add_left_inj, add_right_inj, mul_eq_mul_left_iff]
apply Or.inl
left
rw [HiggsField.innerProd, HiggsField.innerProd, ← InnerProductSpace.conj_symm, Complex.abs_conj]

/-- If `Φ₂` is zero the potential reduces to the Higgs potential on `Φ₁`. -/
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -69,8 +69,7 @@ section sines
/-- For a CKM matrix `sin θ₁₂` is non-negative. -/
lemma S₁₂_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₁₂ V := by
rw [S₁₂, div_nonneg_iff]
apply Or.inl
apply (And.intro (VAbs_ge_zero 0 1 V) (Real.sqrt_nonneg (VudAbs V ^ 2 + VusAbs V ^ 2)))
exact .inl (.intro (VAbs_ge_zero 0 1 V) (Real.sqrt_nonneg (VudAbs V ^ 2 + VusAbs V ^ 2)))

/-- For a CKM matrix `sin θ₁₃` is non-negative. -/
lemma S₁₃_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₁₃ V :=
Expand All @@ -82,8 +81,7 @@ lemma S₂₃_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₂₃ V := by
· rw [S₂₃, if_pos ha]
exact VAbs_ge_zero 1 0 V
· rw [S₂₃, if_neg ha, @div_nonneg_iff]
apply Or.inl
apply And.intro (VAbs_ge_zero 1 2 V) (Real.sqrt_nonneg (VudAbs V ^ 2 + VusAbs V ^ 2))
exact .inl (.intro (VAbs_ge_zero 1 2 V) (Real.sqrt_nonneg (VudAbs V ^ 2 + VusAbs V ^ 2)))

/-- For a CKM matrix `sin θ₁₂` is less then or equal to 1. -/
lemma S₁₂_leq_one (V : Quotient CKMMatrixSetoid) : S₁₂ V ≤ 1 := by
Expand All @@ -95,7 +93,7 @@ lemma S₁₂_leq_one (V : Quotient CKMMatrixSetoid) : S₁₂ V ≤ 1 := by
cases' h2 with h2 h2
simp_all
exact h2
apply Or.inl
left
simp_all only [VudAbs, VusAbs, or_true, Real.sqrt_pos, true_and]
rw [Real.le_sqrt (VAbs_ge_zero 0 1 V) (le_of_lt h3)]
simp only [Fin.isValue, le_add_iff_nonneg_left]
Expand Down
2 changes: 1 addition & 1 deletion HepLean/Lorentz/Group/Boosts.lean
Original file line number Diff line number Diff line change
Expand Up @@ -150,7 +150,7 @@ lemma toMatrix_apply (u v : FuturePointing d) (μ ν : Fin 1 ⊕ Fin d) :
Action.instMonoidalCategory_tensorUnit_V, CategoryTheory.Equivalence.symm_inverse,
Action.functorCategoryEquivalence_functor, Action.FunctorCategoryEquivalence.functor_obj_obj,
Pi.smul_apply, smul_eq_mul, Pi.sub_apply, Pi.neg_apply]
apply Or.inl
left
ring

open minkowskiMatrix in
Expand Down
65 changes: 19 additions & 46 deletions HepLean/Mathematics/Fin/Involutions.lean
Original file line number Diff line number Diff line change
Expand Up @@ -208,8 +208,7 @@ def involutionAddEquiv {n : ℕ} (f : {f : Fin n → Fin n // Function.Involutiv
simp_all only [Subtype.coe_eta] }
let s : Finset (Fin n) := Finset.univ.filter fun i => f.1 i = i
let e2' : { i : Fin n // f.1 i = i} ≃ {i // i ∈ s} := by
refine Equiv.subtypeEquivProp ?h
funext i
apply Equiv.subtypeEquivProp
simp [s]
let e2 : {i // i ∈ s} ≃ Fin (Finset.card s) := by
refine (Finset.orderIsoOfFin _ ?_).symm.toEquiv
Expand Down Expand Up @@ -242,7 +241,7 @@ lemma involutionAddEquiv_cast {n : ℕ} {f1 f2 : {f : Fin n → Fin n // Functio
involutionAddEquiv f1 = (Equiv.subtypeEquivRight (by rw [hf]; simp)).trans
((involutionAddEquiv f2).trans (Equiv.optionCongr (finCongr (by rw [hf])))) := by
subst hf
simp only [finCongr_refl, Equiv.optionCongr_refl, Equiv.trans_refl]
rw [finCongr_refl, Equiv.optionCongr_refl]
rfl

lemma involutionAddEquiv_cast' {m : ℕ} {f1 f2 : {f : Fin m → Fin m // Function.Involutive f}}
Expand All @@ -259,33 +258,18 @@ lemma involutionAddEquiv_none_succ {n : ℕ}
(h : involutionAddEquiv (involutionCons n f).1 (involutionCons n f).2 = none)
(x : Fin n) : f.1 x.succ = x.succ ↔ (involutionCons n f).1.1 x = x := by
simp only [succ_eq_add_one, involutionCons, Fin.cons_update, Equiv.coe_fn_mk, dite_eq_left_iff]
have hn' := involutionAddEquiv_none_image_zero h
have hx : ¬ f.1 x.succ = ⟨0, Nat.zero_lt_succ n⟩:= by
rw [← hn']
exact fun hn => Fin.succ_ne_zero x (Function.Involutive.injective f.2 hn)
apply Iff.intro
· intro h2 h3
rw [Fin.ext_iff]
simp [h2]
· intro h2
have h2' := h2 hx
conv_rhs => rw [← h2']
simp
have hx : ¬ f.1 x.succ = ⟨0, Nat.zero_lt_succ n⟩:=
involutionAddEquiv_none_image_zero h ▸
fun hn => Fin.succ_ne_zero x (Function.Involutive.injective f.2 hn)
exact Iff.intro (fun h2 ↦ by simp [h2]) (fun h2 ↦ (Fin.pred_eq_iff_eq_succ hx).mp (h2 hx))

lemma involutionAddEquiv_isSome_image_zero {n : ℕ} :
{f : {f : Fin n.succ → Fin n.succ // Function.Involutive f}}
→ (involutionAddEquiv (involutionCons n f).1 (involutionCons n f).2).isSome
→ ¬ f.1 ⟨0, Nat.zero_lt_succ n⟩ = ⟨0, Nat.zero_lt_succ n⟩ := by
intro f hf
simp only [succ_eq_add_one, involutionCons, Equiv.coe_fn_mk, involutionAddEquiv,
Option.isSome_some, Option.get_some, Option.isSome_none, Equiv.trans_apply,
Equiv.optionCongr_apply, Equiv.coe_trans, RelIso.coe_fn_toEquiv, Option.isSome_map'] at hf
simp_all only [List.length_cons, Fin.zero_eta]
obtain ⟨val, property⟩ := f
simp_all only [List.length_cons]
apply Aesop.BuiltinRules.not_intro
intro a
simp_all only [↓reduceDIte, Option.isSome_none, Bool.false_eq_true]
intro f hf a
simp only [succ_eq_add_one, involutionCons, Equiv.coe_fn_mk, involutionAddEquiv] at hf
simp_all

/-!

Expand All @@ -303,15 +287,11 @@ def involutionNoFixedEquivSum {n : ℕ} :
∧ (∀ i, f i ≠ i) ∧ f 0 = k.succ} where
toFun f := ⟨(f.1 0).pred (f.2.2 0), ⟨f.1, f.2.1, by simpa using f.2.2⟩⟩
invFun f := ⟨f.2.1, ⟨f.2.2.1, f.2.2.2.1⟩⟩
left_inv f := by
rfl
left_inv f := rfl
right_inv f := by
simp only [succ_eq_add_one, ne_eq, mul_eq]
ext
· simp only [Fin.coe_pred]
rw [f.2.2.2.2]
simp
· simp
· simp [f.2.2.2.2]
· rfl

/-- The condition on fixed point free involutions of `Fin n.succ` for a fixed value of `f 0`,
can be modified by conjugation with an equivalence. -/
Expand All @@ -329,8 +309,7 @@ def involutionNoFixedZeroSetEquivEquiv {n : ℕ}
intro i
simp only [succ_eq_add_one, Function.comp_apply, ne_eq, Equiv.apply_symm_apply]
have hf2 := f.2.1 i
simpa using hf2, by
simpa using f.2.2.1, by simpa using f.2.2.2⟩
simpa using hf2, by simpa using f.2.2.1, by simpa using f.2.2.2⟩
left_inv f := by
ext i
simp
Expand Down Expand Up @@ -485,7 +464,7 @@ def involutionNoFixedSetOne {n : ℕ} :
simp [Fin.ext_iff] at h
| ⟨(Nat.succ (Nat.succ m)), h⟩ =>
simp only [succ_eq_add_one, ne_eq, Fin.ext_iff, Fin.val_succ, add_left_inj, f']
have hf:= f.2.2 ⟨m, by exact Nat.add_lt_add_iff_right.mp h⟩
have hf:= f.2.2 ⟨m, Nat.add_lt_add_iff_right.mp h⟩
simp only [ne_eq, Fin.ext_iff] at hf
omega
· simp only [succ_eq_add_one, ne_eq, f']
Expand All @@ -505,13 +484,9 @@ def involutionNoFixedSetOne {n : ℕ} :
ext i
simp only
split
· simp only [Fin.val_one, succ_eq_add_one, Fin.zero_eta]
rw [f.2.2.2]
simp
· simp only [Fin.val_zero, succ_eq_add_one, Fin.mk_one]
rw [hf1]
simp
· rfl
· simp [Fin.val_one, succ_eq_add_one, Fin.zero_eta, f.2.2.2]
· exact congrArg Fin.val (id (Eq.symm hf1))
· exact rfl
right_inv f := by
simp only [ne_eq, mul_eq, succ_eq_add_one, Function.comp_apply]
ext i
Expand All @@ -521,8 +496,7 @@ def involutionNoFixedSetOne {n : ℕ} :
simp [Fin.ext_iff] at h
· rename_i h
simp [Fin.ext_iff] at h
· rename_i h
simp only [Fin.val_succ, add_tsub_cancel_right]
· simp only [Fin.val_succ, add_tsub_cancel_right]
congr
apply congrArg
simp_all [Fin.ext_iff]
Expand Down Expand Up @@ -552,8 +526,7 @@ def involutionNoFixedZeroEquivProd {n : ℕ} :
≃ Fin n.succ ×
{f : Fin n → Fin n // Function.Involutive f ∧ (∀ i, f i ≠ i)} := by
refine Equiv.trans involutionNoFixedEquivSumSame ?_
exact Equiv.sigmaEquivProd (Fin n.succ)
{ f // Function.Involutive f ∧ ∀ (i : Fin n), f i ≠ i}
exact Equiv.sigmaEquivProd (Fin n.succ) { f // Function.Involutive f ∧ ∀ (i : Fin n), f i ≠ i }

/-!

Expand Down
2 changes: 1 addition & 1 deletion HepLean/Mathematics/List.lean
Original file line number Diff line number Diff line change
Expand Up @@ -707,7 +707,7 @@ lemma eraseIdx_get {I : Type} (l : List I) (i : Fin l.length) :
ext x
simp only [Function.comp_apply, List.get_eq_getElem, List.eraseIdx, List.getElem_eraseIdx]
simp only [Fin.succAbove, Fin.coe_cast]
by_cases hi: x.castSucc < Fin.cast (by exact Eq.symm (eraseIdx_length l i)) i
by_cases hi: x.castSucc < Fin.cast (Eq.symm (eraseIdx_length l i)) i
· simp only [hi, ↓reduceIte, Fin.coe_castSucc, dite_eq_left_iff, not_lt]
intro h
rw [Fin.lt_def] at hi
Expand Down
2 changes: 1 addition & 1 deletion HepLean/Mathematics/List/InsertionSort.lean
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ lemma insertionSortMin_lt_mem_insertionSortDropMinPos {α : Type} (r : α → α
(i : Fin (insertionSortDropMinPos r a l).length) :
r (insertionSortMin r a l) ((insertionSortDropMinPos r a l)[i]) := by
let l1 := List.insertionSort r (a :: l)
have hl1 : l1.Sorted r := by exact List.sorted_insertionSort r (a :: l)
have hl1 : l1.Sorted r := List.sorted_insertionSort r (a :: l)
simp only [l1] at hl1
rw [insertionSort_eq_insertionSortMin_cons r a l] at hl1
simp only [List.sorted_cons, List.mem_insertionSort] at hl1
Expand Down
Loading
Loading