diff --git a/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean b/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean index 7ec778c9c..13344fde9 100644 --- a/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean +++ b/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean @@ -168,22 +168,16 @@ lemma energy_dissipation_rate (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (t : (hx : ContDiff ℝ ∞ xₜ) : ∂ₜ (S.energy xₜ) t = - S.γ * ⟪∂ₜ xₜ t, ∂ₜ xₜ t⟫_ℝ := by rw [S.energy_deriv xₜ hx] - simp only - have heom := h1 t have hforce : S.m • ∂ₜ (∂ₜ xₜ) t + S.k • xₜ t = - S.γ • ∂ₜ xₜ t := by - have hsum : (S.m • ∂ₜ (∂ₜ xₜ) t + S.k • xₜ t) + S.γ • ∂ₜ xₜ t = 0 := by - simpa [add_assoc, add_left_comm, add_comm] using heom - simpa [neg_smul] using eq_neg_of_add_eq_zero_left hsum - rw [hforce] - simp [inner_smul_right] + linear_combination (norm := module) h1 t + simp [hforce, inner_smul_right] /-- If `0 < γ` and the velocity is nonzero at a time, the mechanical energy is strictly decreasing at that time. -/ lemma energy_not_conserved (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) (h1 : S.EquationOfMotion xₜ) (hx : ContDiff ℝ ∞ xₜ) (hdx : ∂ₜ xₜ t ≠ 0) (hγ : 0 < S.γ) : ∂ₜ (S.energy xₜ) t < 0 := by - rw [energy_dissipation_rate S xₜ t h1 hx] - rw [neg_mul] + rw [energy_dissipation_rate S xₜ t h1 hx, neg_mul] exact neg_neg_of_pos (mul_pos hγ (real_inner_self_pos.mpr hdx)) /-! @@ -221,16 +215,9 @@ lemma equationOfMotion_iff_newtons_2nd_law (xₜ : Time → EuclideanSpace ℝ ( simp only [EquationOfMotion, force] constructor · intro h t - have h' : - S.m • ∂ₜ (∂ₜ xₜ) t + (S.γ • ∂ₜ xₜ t + S.k • xₜ t) = 0 := by - simpa [add_assoc] using h t - have ha : - S.m • ∂ₜ (∂ₜ xₜ) t = -(S.γ • ∂ₜ xₜ t + S.k • xₜ t) := - eq_neg_of_add_eq_zero_left h' - simpa [sub_eq_add_neg, neg_add, add_comm] using ha + linear_combination (norm := module) h t · intro h t - rw [h t] - module + linear_combination (norm := module) h t /-! ## D. Damping regimes @@ -283,40 +270,23 @@ lemma discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq : /-- The decay rate is nonnegative. -/ lemma decayRate_nonneg : 0 ≤ S.decayRate := by - rw [decayRate] exact div_nonneg S.γ_nonneg (by nlinarith [S.m_pos]) /-- An undamped oscillator lies in the underdamped regime. -/ lemma isUnderdamped_of_gamma_eq_zero (hγ : S.γ = 0) : S.IsUnderdamped := by - rw [IsUnderdamped, discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq S, decayRate] - rw [hγ] - ring_nf - nlinarith [sq_pos_of_pos S.m_pos, sq_pos_of_pos S.ω_pos] + rw [IsUnderdamped, discriminant, hγ] + nlinarith [mul_pos S.m_pos S.k_pos] /-- An underdamped system has decay rate less than the natural frequency. -/ lemma isUnderdamped_decayRate (hS : S.IsUnderdamped) : S.decayRate < S.ω := by - rw [IsUnderdamped] at hS - rw [discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] at hS - have hm_sq_pos : 0 < 4 * S.m^2 := by - have hsq : 0 < S.m^2 := sq_pos_of_pos S.m_pos - nlinarith - have hsq : S.decayRate^2 < S.ω^2 := by - nlinarith + rw [IsUnderdamped, discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] at hS + have hsq : S.decayRate ^ 2 < S.ω ^ 2 := by nlinarith [sq_pos_of_pos S.m_pos] nlinarith [S.decayRate_nonneg, S.ω_pos] /-- A critically damped system has decay rate equal to the natural frequency. -/ lemma isCriticallyDamped_decayRate (hS : S.IsCriticallyDamped) : S.ω = S.decayRate := by - rw [IsCriticallyDamped] at hS - rw [discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] at hS - have hm_sq_ne_zero : 4 * S.m^2 ≠ 0 := by - have hm_sq_pos : 0 < 4 * S.m^2 := by - have hsq : 0 < S.m^2 := sq_pos_of_pos S.m_pos - nlinarith - exact ne_of_gt hm_sq_pos - have hsq : S.decayRate^2 = S.ω^2 := by - have hsub : S.decayRate^2 - S.ω^2 = 0 := by - exact (mul_eq_zero.mp hS).resolve_left hm_sq_ne_zero - linarith + rw [IsCriticallyDamped, discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] at hS + have hsq : S.decayRate ^ 2 = S.ω ^ 2 := by nlinarith [sq_pos_of_pos S.m_pos] nlinarith [S.decayRate_nonneg, S.ω_pos] /-- The damping coefficient is twice mass times the decay rate. -/ @@ -332,55 +302,30 @@ lemma k_eq_m_mul_ω_sq : S.k = S.m * S.ω^2 := by /-- In the critically damped regime, `k = m * decayRate^2`. -/ lemma k_eq_m_mul_decayRate_sq_of_criticallyDamped (hS : S.IsCriticallyDamped) : S.k = S.m * S.decayRate^2 := by - have hωa : S.ω = S.decayRate := S.isCriticallyDamped_decayRate hS - have hωsq : S.decayRate ^ 2 = S.k / S.m := by - simpa [hωa] using S.ω_sq - field_simp [S.m_ne_zero] at hωsq - nlinarith + rw [S.k_eq_m_mul_ω_sq, S.isCriticallyDamped_decayRate hS] /-- An overdamped system has decay rate greater than the natural frequency. -/ lemma isOverdamped_decayRate (hS : S.IsOverdamped) : S.ω < S.decayRate := by - rw [IsOverdamped] at hS - rw [discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] at hS - have hm_sq_pos : 0 < 4 * S.m^2 := by - have hsq : 0 < S.m^2 := sq_pos_of_pos S.m_pos - nlinarith - have hsq : S.ω^2 < S.decayRate^2 := by - nlinarith + rw [IsOverdamped, discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] at hS + have hsq : S.ω ^ 2 < S.decayRate ^ 2 := by nlinarith [sq_pos_of_pos S.m_pos] nlinarith [S.decayRate_nonneg, S.ω_pos] /-- In the underdamped regime, the selected frequency uses the oscillation frequency. -/ lemma angularFrequency_eq_underdamped (hS : S.IsUnderdamped) : S.angularFrequency = sqrt (- S.discriminant) / (2 * S.m) := by - classical simp [angularFrequency, hS] /-- In the critically damped regime, the selected frequency is zero. -/ lemma angularFrequency_eq_criticallyDamped (hS : S.IsCriticallyDamped) : S.angularFrequency = 0 := by - classical - have hnotUnder : ¬ S.IsUnderdamped := by - intro hUnder - rw [IsUnderdamped] at hUnder - rw [IsCriticallyDamped] at hS - linarith - simp [angularFrequency, hnotUnder, hS] + rw [IsCriticallyDamped] at hS + simp [angularFrequency, IsUnderdamped, IsCriticallyDamped, hS] /-- In the overdamped regime, the selected frequency uses the real split rate. -/ lemma angularFrequency_eq_overdamped (hS : S.IsOverdamped) : S.angularFrequency = sqrt S.discriminant / (2 * S.m) := by - classical - have hnotUnder : ¬ S.IsUnderdamped := by - intro hUnder - rw [IsUnderdamped] at hUnder - rw [IsOverdamped] at hS - linarith - have hnotCritical : ¬ S.IsCriticallyDamped := by - intro hCritical - rw [IsCriticallyDamped] at hCritical - rw [IsOverdamped] at hS - linarith - simp [angularFrequency, hnotUnder, hnotCritical] + rw [IsOverdamped] at hS + simp [angularFrequency, IsUnderdamped, IsCriticallyDamped, not_lt.mpr hS.le, hS.ne'] /-- In the underdamped regime, the selected angular frequency squares to `ω^2 - decayRate^2`. -/ @@ -390,22 +335,18 @@ lemma angularFrequency_sq_of_underdamped (hS : S.IsUnderdamped) : · rw [discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] field_simp [S.m_ne_zero] ring - · rw [IsUnderdamped] at hS - exact le_of_lt (neg_pos.mpr hS) + · exact (neg_pos.mpr hS).le /-- The selected angular frequency is positive in the underdamped regime. -/ lemma angularFrequency_pos_of_underdamped (hS : S.IsUnderdamped) : 0 < S.angularFrequency := by rw [S.angularFrequency_eq_underdamped hS] - apply div_pos - · rw [IsUnderdamped] at hS - exact sqrt_pos.mpr (neg_pos.mpr hS) - · nlinarith [S.m_pos] + exact div_pos (sqrt_pos.mpr (neg_pos.mpr hS)) (by linarith [S.m_pos]) /-- The selected angular frequency is nonzero in the underdamped regime. -/ lemma angularFrequency_ne_zero_of_underdamped (hS : S.IsUnderdamped) : S.angularFrequency ≠ 0 := - Ne.symm (ne_of_lt (S.angularFrequency_pos_of_underdamped hS)) + (S.angularFrequency_pos_of_underdamped hS).ne' /-- In the overdamped regime, the selected angular frequency squares to `decayRate^2 - ω^2`. -/ @@ -415,22 +356,18 @@ lemma angularFrequency_sq_of_overdamped (hS : S.IsOverdamped) : · rw [discriminant_eq_four_mul_m_sq_mul_decayRate_sq_sub_ω_sq] field_simp [S.m_ne_zero] ring - · rw [IsOverdamped] at hS - exact le_of_lt hS + · exact le_of_lt hS /-- The selected angular frequency is positive in the overdamped regime. -/ lemma angularFrequency_pos_of_overdamped (hS : S.IsOverdamped) : 0 < S.angularFrequency := by rw [S.angularFrequency_eq_overdamped hS] - apply div_pos - · rw [IsOverdamped] at hS - exact sqrt_pos.mpr hS - · nlinarith [S.m_pos] + exact div_pos (sqrt_pos.mpr hS) (by linarith [S.m_pos]) /-- The selected angular frequency is nonzero in the overdamped regime. -/ lemma angularFrequency_ne_zero_of_overdamped (hS : S.IsOverdamped) : S.angularFrequency ≠ 0 := - Ne.symm (ne_of_lt (S.angularFrequency_pos_of_overdamped hS)) + (S.angularFrequency_pos_of_overdamped hS).ne' /-! ## E. To undamped oscillator @@ -455,23 +392,13 @@ for the corresponding undamped harmonic oscillator. -/ lemma toUndamped_equationOfMotion (S : DampedHarmonicOscillator) (hS : S.IsUndamped) (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) : S.EquationOfMotion xₜ ↔ (S.toUndamped hS).EquationOfMotion xₜ := by - have hγ : S.γ = 0 := by - simpa [IsUndamped] using hS + have hγ : S.γ = 0 := by simpa [IsUndamped] using hS rw [S.equationOfMotion_iff_newtons_2nd_law xₜ, (S.toUndamped hS).equationOfMotion_iff_newtons_2nd_law xₜ hx] - constructor - · intro h t - calc - (S.toUndamped hS).m • ∂ₜ (∂ₜ xₜ) t = S.m • ∂ₜ (∂ₜ xₜ) t := rfl - _ = force S xₜ t := h t - _ = HarmonicOscillator.force (S.toUndamped hS) (xₜ t) := by - simp [force, HarmonicOscillator.force_eq_linear, toUndamped, hγ] - · intro h t - calc - S.m • ∂ₜ (∂ₜ xₜ) t = (S.toUndamped hS).m • ∂ₜ (∂ₜ xₜ) t := rfl - _ = HarmonicOscillator.force (S.toUndamped hS) (xₜ t) := h t - _ = force S xₜ t := by - simp [force, HarmonicOscillator.force_eq_linear, toUndamped, hγ] + refine forall_congr' fun t => ?_ + rw [show (S.toUndamped hS).m = S.m from rfl, + show HarmonicOscillator.force (S.toUndamped hS) (xₜ t) = force S xₜ t from by + simp [force, HarmonicOscillator.force_eq_linear, toUndamped, hγ]] /-! @@ -531,8 +458,7 @@ lemma lagrangian_of_isUndamped (hS : S.IsUndamped) : S.lagrangian = S.toHarmonicOscillator.lagrangian := by have hγ : S.γ = 0 := by simpa [IsUndamped] using hS funext t x v - rw [lagrangian, hγ] - simp + simp [lagrangian, hγ] /-! @@ -544,10 +470,8 @@ The lagrangian is smooth in all its arguments. @[fun_prop] lemma contDiff_lagrangian (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.lagrangian := by - have h : ↿S.lagrangian = - fun p : Time × EuclideanSpace ℝ (Fin 1) × EuclideanSpace ℝ (Fin 1) => - exp (S.γ / S.m * p.1) * ↿S.toHarmonicOscillator.lagrangian p := rfl - rw [h] + show ContDiff ℝ n fun p : Time × EuclideanSpace ℝ (Fin 1) × EuclideanSpace ℝ (Fin 1) => + exp (S.γ / S.m * p.1) * ↿S.toHarmonicOscillator.lagrangian p fun_prop /-! @@ -563,19 +487,16 @@ lagrangian, using that the gradient scales with the constant `exp (γ/m * t)`. private lemma gradient_const_mul {f : EuclideanSpace ℝ (Fin 1) → ℝ} {x : EuclideanSpace ℝ (Fin 1)} (c : ℝ) (hf : DifferentiableAt ℝ f x) : gradient (fun y => c * f y) x = c • gradient f x := by - unfold gradient - rw [fderiv_const_mul hf] - simp [map_smul] + simp [gradient, fderiv_const_mul hf, map_smul] lemma gradient_lagrangian_position_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : gradient (fun x => S.lagrangian t x v) x = -(exp (S.γ / S.m * t) * S.k) • x := by have hf : DifferentiableAt ℝ (fun y => S.toHarmonicOscillator.lagrangian t y v) x := by simp only [HarmonicOscillator.lagrangian_eq] fun_prop - have h_eq : (fun y => S.lagrangian t y v) = - fun y => exp (S.γ / S.m * t) * S.toHarmonicOscillator.lagrangian t y v := rfl - rw [h_eq, gradient_const_mul _ hf, - S.toHarmonicOscillator.gradient_lagrangian_position_eq] + rw [show (fun y => S.lagrangian t y v) = + fun y => exp (S.γ / S.m * t) * S.toHarmonicOscillator.lagrangian t y v from rfl, + gradient_const_mul _ hf, S.toHarmonicOscillator.gradient_lagrangian_position_eq] module lemma gradient_lagrangian_velocity_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : @@ -583,10 +504,9 @@ lemma gradient_lagrangian_velocity_eq (t : Time) (x v : EuclideanSpace ℝ (Fin have hf : DifferentiableAt ℝ (fun w => S.toHarmonicOscillator.lagrangian t x w) v := by simp only [HarmonicOscillator.lagrangian_eq] fun_prop - have h_eq : S.lagrangian t x = - fun w => exp (S.γ / S.m * t) * S.toHarmonicOscillator.lagrangian t x w := rfl - rw [h_eq, gradient_const_mul _ hf, - S.toHarmonicOscillator.gradient_lagrangian_velocity_eq, smul_smul] + rw [show S.lagrangian t x = + fun w => exp (S.γ / S.m * t) * S.toHarmonicOscillator.lagrangian t x w from rfl, + gradient_const_mul _ hf, S.toHarmonicOscillator.gradient_lagrangian_velocity_eq, smul_smul] /-! @@ -627,9 +547,8 @@ private lemma deriv_exp_smul (a : ℝ) (y : Time → EuclideanSpace ℝ (Fin 1)) (hy : Differentiable ℝ y) (t : Time) : ∂ₜ (fun t' : Time => exp (a * t'.val) • y t') t = exp (a * t.val) • (∂ₜ y t + a • y t) := by - rw [Time.deriv] - rw [fderiv_fun_smul (by fun_prop) (hy t)] - rw [fderiv_exp (by fun_prop), fderiv_fun_mul (by fun_prop) (by fun_prop)] + rw [Time.deriv, fderiv_fun_smul (by fun_prop) (hy t), fderiv_exp (by fun_prop), + fderiv_fun_mul (by fun_prop) (by fun_prop)] simp only [_root_.add_apply, _root_.smul_apply, ContinuousLinearMap.smulRight_apply, Time.fderiv_val, smul_eq_mul, mul_one] rw [← Time.deriv_eq] @@ -650,8 +569,8 @@ lemma gradLagrangian_eq_force (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : arg 1 ext t' rw [gradient_lagrangian_velocity_eq, ← smul_smul] - rw [deriv_exp_smul (S.γ / S.m) (fun t' => S.m • ∂ₜ xₜ t') (hdx.const_smul S.m) t] - rw [Time.deriv_smul _ _ hdx, smul_smul, div_mul_cancel₀ _ S.m_ne_zero] + rw [deriv_exp_smul (S.γ / S.m) (fun t' => S.m • ∂ₜ xₜ t') (hdx.const_smul S.m) t, + Time.deriv_smul _ _ hdx, smul_smul, div_mul_cancel₀ _ S.m_ne_zero] rw [gradient_lagrangian_position_eq, h2, force] module diff --git a/Physlib/ClassicalMechanics/FreeParticle/Basic.lean b/Physlib/ClassicalMechanics/FreeParticle/Basic.lean index 260121a7c..7609b89b3 100644 --- a/Physlib/ClassicalMechanics/FreeParticle/Basic.lean +++ b/Physlib/ClassicalMechanics/FreeParticle/Basic.lean @@ -138,11 +138,8 @@ Since the particle mass is strictly positive, the equation factor. -/ lemma accel_zero (s : FreeParticle) (q : Trajectory) (h : ∀ t, s.NewtonsSecondLaw q t) : - ∀ t, deriv (deriv q) t = 0 := by - intro t - have h₀ : s.mass ≠ 0 := ne_of_gt s.mass_pos - have h1 := h t - exact (mul_eq_zero.mp h1).resolve_left h₀ + ∀ t, deriv (deriv q) t = 0 := + fun t => (mul_eq_zero.mp (h t)).resolve_left s.mass_pos.ne' /-- If the acceleration of a trajectory vanishes everywhere, then the @@ -160,18 +157,12 @@ lemma velocity_const_of_zero_acc (q : Time → ℝ) (h : ∀ t, deriv (deriv q) (hcont : ContDiff ℝ 2 q) : ∃ v₀, ∀ t, deriv q t = v₀ := by refine ⟨deriv q 0, fun t => ?_⟩ refine is_const_of_fderiv_eq_zero (𝕜 := ℝ) (f := deriv q) ?_ ?_ t 0 - · change Differentiable ℝ ((fun L : Time →L[ℝ] ℝ => L 1) ∘ fun t => fderiv ℝ q t) + · unfold Time.deriv fun_prop · intro t ext p - simp only [zero_apply] - have hp : p = p.val • (1 : Time) := by - ext - simp - rw [hp] - simp only [map_smul, smul_eq_mul, mul_eq_zero] - right - simpa [Time.deriv_eq] using h t + have hp : p = p.val • (1 : Time) := Time.ext (by simp) + rw [hp, zero_apply, map_smul, smul_eq_mul, ← Time.deriv_eq, h t, mul_zero] /-- If a free-particle trajectory has constant velocity, then its linear momentum is constant. @@ -179,10 +170,8 @@ If a free-particle trajectory has constant velocity, then its linear momentum is lemma linearMomentum_conserved_of_velocity_const (s : FreeParticle) (q : Trajectory) (h : ∃ v₀, ∀ t, s.velocity q t = v₀) : ∃ p, ∀ t, s.linearMomentum q t = p := by - rcases h with ⟨v₀, hv⟩ - refine ⟨s.mass * v₀, fun t => ?_⟩ - unfold linearMomentum - rw [hv t] + obtain ⟨v₀, hv⟩ := h + exact ⟨s.mass * v₀, fun t => by simp [linearMomentum, hv]⟩ /-- A free particle satisfying the equation of motion conserves linear momentum. @@ -192,11 +181,9 @@ Since the particle mass is fixed, the linear momentum is constant in time. -/ theorem linearMomentum_conserved (s : FreeParticle) (q : Trajectory) (h : ∀ t, s.NewtonsSecondLaw q t) (hcont : ContDiff ℝ 2 q) : - ∃ p, ∀ t, s.linearMomentum q t = p := by - have h_acc : ∀ t, deriv (deriv q) t = 0 := - accel_zero s q h - rcases velocity_const_of_zero_acc q h_acc hcont with ⟨v₀, hv⟩ - exact linearMomentum_conserved_of_velocity_const s q ⟨v₀, hv⟩ + ∃ p, ∀ t, s.linearMomentum q t = p := + linearMomentum_conserved_of_velocity_const s q + (velocity_const_of_zero_acc q (accel_zero s q h) hcont) /-- A free particle satisfying the equation of motion conserves kinetic energy. @@ -210,15 +197,9 @@ energy is constant in time. theorem kineticEnergy_conserved (s : FreeParticle) (q : Trajectory) (h : ∀ t, s.NewtonsSecondLaw q t) (hcont : ContDiff ℝ 2 q) : ∃ E, ∀ t, s.kineticEnergy q t = E := by - -- get q'' = 0 - have h_acc : ∀ t, deriv (deriv q) t = 0 := - accel_zero s q h - -- get constant velocity - rcases velocity_const_of_zero_acc q h_acc hcont with ⟨v₀, hv⟩ - -- energy is constant + obtain ⟨v₀, hv⟩ := velocity_const_of_zero_acc q (accel_zero s q h) hcont refine ⟨(1 / 2) * s.mass * v₀^2, fun t => ?_⟩ - unfold kineticEnergy velocity - rw [hv t] + simp only [kineticEnergy, velocity, hv] end FreeParticle end ClassicalMechanics diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean index 347e2bc7e..7147a691c 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean @@ -126,10 +126,10 @@ namespace HarmonicOscillator variable (S : HarmonicOscillator) @[simp] -lemma k_ne_zero : S.k ≠ 0 := Ne.symm (ne_of_lt S.k_pos) +lemma k_ne_zero : S.k ≠ 0 := S.k_pos.ne' @[simp] -lemma m_ne_zero : S.m ≠ 0 := Ne.symm (ne_of_lt S.m_pos) +lemma m_ne_zero : S.m ≠ 0 := S.m_pos.ne' /-! @@ -154,18 +154,14 @@ noncomputable def ω : ℝ := √(S.k / S.m) lemma ω_pos : 0 < S.ω := sqrt_pos.mpr (div_pos S.k_pos S.m_pos) /-- The square of the angular frequency of the classical harmonic oscillator is equal to `k/m`. -/ -lemma ω_sq : S.ω^2 = S.k / S.m := by - rw [ω, sq_sqrt] - exact div_nonneg (le_of_lt S.k_pos) (le_of_lt S.m_pos) +lemma ω_sq : S.ω^2 = S.k / S.m := sq_sqrt (div_pos S.k_pos S.m_pos).le /-- The angular frequency of the classical harmonic oscillator is not equal to zero. -/ -lemma ω_ne_zero : S.ω ≠ 0 := Ne.symm (ne_of_lt S.ω_pos) +lemma ω_ne_zero : S.ω ≠ 0 := S.ω_pos.ne' /-- The inverse of the square of the angular frequency of the classical harmonic oscillator is `m/k`. -/ -lemma inverse_ω_sq : (S.ω ^ 2)⁻¹ = S.m/S.k := by - rw [ω_sq] - field_simp +lemma inverse_ω_sq : (S.ω ^ 2)⁻¹ = S.m/S.k := by rw [ω_sq, inv_div] /-! @@ -227,20 +223,14 @@ On smooth trajectories the energies are differentiable. lemma kineticEnergy_differentiable (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) : Differentiable ℝ (kineticEnergy S xₜ) := by rw [kineticEnergy_eq] - change Differentiable ℝ ((fun x => (1 / (2 : ℝ)) * S.m * ⟪x, x⟫_ℝ) ∘ (fun t => ∂ₜ xₜ t)) - apply Differentiable.comp - · fun_prop - · exact deriv_differentiable_of_contDiff xₜ hx + fun_prop @[fun_prop] lemma potentialEnergy_differentiable (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) : Differentiable ℝ (fun t => potentialEnergy S (xₜ t)) := by - simp only [potentialEnergy_eq, one_div, smul_eq_mul] - change Differentiable ℝ ((fun x => 2⁻¹ * (S.k * ⟪x, x⟫_ℝ)) ∘ xₜ) - apply Differentiable.comp - · fun_prop - · rw [contDiff_infty_iff_fderiv] at hx - exact hx.1 + have hd : Differentiable ℝ xₜ := hx.differentiable (by simp) + simp only [potentialEnergy_eq] + fun_prop @[fun_prop] lemma energy_differentiable (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) : @@ -261,56 +251,30 @@ lemma kineticEnergy_deriv (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : Con ∂ₜ (kineticEnergy S xₜ) = fun t => ⟪∂ₜ xₜ t, S.m • ∂ₜ (∂ₜ xₜ) t⟫_ℝ := by funext t unfold kineticEnergy - conv_lhs => simp only [Time.deriv, one_div, ringHom_apply] - change (fderiv ℝ ((fun x => 2⁻¹ * S.m * ⟪x, x⟫_ℝ) ∘ (fun t => ∂ₜ xₜ t)) t) 1 = _ - rw [fderiv_comp] - rw [fderiv_const_mul (by fun_prop)] - simp only [ContinuousLinearMap.smul_comp, FunLike.coe_smul, - ContinuousLinearMap.coe_comp, Pi.smul_apply, Function.comp_apply, smul_eq_mul] - rw [fderiv_inner_apply] - simp only [fderiv_fun_id, ContinuousLinearMap.coe_id', id_eq] - rw [real_inner_comm, ← inner_add_left, ← Time.deriv, real_inner_comm, ← inner_smul_right] - congr 1 - simp only [smul_add] - module - repeat fun_prop + have hd : DifferentiableAt ℝ (∂ₜ xₜ) t := + (deriv_differentiable_of_contDiff xₜ hx).differentiableAt + rw [Time.deriv_eq, fderiv_const_mul (by fun_prop), _root_.smul_apply, + fderiv_inner_apply (𝕜 := ℝ) hd hd, ← Time.deriv_eq] + simp [inner_smul_right, real_inner_comm] + ring lemma potentialEnergy_deriv (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) : ∂ₜ (fun t => potentialEnergy S (xₜ t)) = fun t => ⟪∂ₜ xₜ t, S.k • xₜ t⟫_ℝ := by funext t - unfold potentialEnergy - conv_lhs => simp only [Time.deriv, one_div, smul_eq_mul] - change (fderiv ℝ ((fun x => 2⁻¹ * (S.k * ⟪x, x⟫_ℝ)) ∘ (fun t => xₜ t)) t) 1 = _ - rw [fderiv_comp] - rw [fderiv_const_mul (by fun_prop), fderiv_const_mul (by fun_prop)] - simp only [ContinuousLinearMap.smul_comp, FunLike.coe_smul, - ContinuousLinearMap.coe_comp, Pi.smul_apply, Function.comp_apply, smul_eq_mul] - rw [fderiv_inner_apply] - simp only [fderiv_fun_id, ContinuousLinearMap.coe_id', id_eq] - trans S.k * ⟪xₜ t, ∂ₜ xₜ t⟫_ℝ - · rw [real_inner_comm, ← inner_add_left, ← Time.deriv, real_inner_comm, ← inner_smul_right, - ← inner_smul_right, ← inner_smul_right] - congr 1 - module - rw [real_inner_comm, ← inner_smul_right] - repeat fun_prop - apply Differentiable.differentiableAt - rw [contDiff_infty_iff_fderiv] at hx - exact hx.1 + have hd : DifferentiableAt ℝ xₜ t := (hx.differentiable (by simp)).differentiableAt + simp only [potentialEnergy_eq, smul_eq_mul, ← mul_assoc] + rw [Time.deriv_eq, fderiv_const_mul (by fun_prop), _root_.smul_apply, + fderiv_inner_apply (𝕜 := ℝ) hd hd, ← Time.deriv_eq] + simp [inner_smul_right, real_inner_comm] + ring lemma energy_deriv (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) : ∂ₜ (energy S xₜ) = fun t => ⟪∂ₜ xₜ t, S.m • ∂ₜ (∂ₜ xₜ) t + S.k • xₜ t⟫_ℝ := by unfold energy funext t - rw [Time.deriv_eq] - rw [fderiv_fun_add (by fun_prop) (by apply S.potentialEnergy_differentiable xₜ hx)] - simp only [_root_.add_apply] - rw [← Time.deriv_eq, ← Time.deriv_eq] - rw [potentialEnergy_deriv, kineticEnergy_deriv] - simp only - rw [← inner_add_right] - fun_prop - fun_prop + rw [Time.deriv_eq, fderiv_fun_add (by fun_prop) (S.potentialEnergy_differentiable xₜ hx t)] + simp only [_root_.add_apply, ← Time.deriv_eq, kineticEnergy_deriv _ _ hx, + potentialEnergy_deriv _ _ hx, ← inner_add_right] /-! @@ -353,15 +317,12 @@ set_option linter.unusedVariables false in lemma lagrangian_eq : lagrangian S = fun t x v => 1 / (2 : ℝ) * S.m * ⟪v, v⟫_ℝ - 1 / (2 : ℝ) * S.k * ⟪x, x⟫_ℝ := by ext t x v - simp [lagrangian, potentialEnergy] - ring + simp [lagrangian, potentialEnergy, mul_assoc] lemma lagrangian_eq_kineticEnergy_sub_potentialEnergy (t : Time) (xₜ : Time → EuclideanSpace ℝ (Fin 1)) : lagrangian S t (xₜ t) (∂ₜ xₜ t) = kineticEnergy S xₜ t - potentialEnergy S (xₜ t) := by - rw [lagrangian_eq, kineticEnergy, potentialEnergy] - simp only [one_div, smul_eq_mul, sub_right_inj] - ring + rfl /-! @@ -374,54 +335,26 @@ The lagrangian is smooth in all its arguments. @[fun_prop] lemma contDiff_lagrangian (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.lagrangian := by rw [lagrangian_eq] - apply ContDiff.sub - · apply ContDiff.mul - · apply ContDiff.mul - · exact contDiff_const - · exact contDiff_const - · exact ContDiff.inner (𝕜 := ℝ) (contDiff_snd.comp contDiff_snd) - (contDiff_snd.comp contDiff_snd) - · apply ContDiff.mul - · apply ContDiff.mul - · exact contDiff_const - · exact contDiff_const - · exact ContDiff.inner (𝕜 := ℝ) (contDiff_fst.comp contDiff_snd) - (contDiff_fst.comp contDiff_snd) + fun_prop lemma toDual_symm_innerSL (x : EuclideanSpace ℝ (Fin 1)) : - (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm (innerSL ℝ x) = x := by - apply (innerSL_inj (𝕜:=ℝ) (E:=EuclideanSpace ℝ (Fin 1))).1 - ext y - simp [InnerProductSpace.toDual_symm_apply] + (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm (innerSL ℝ x) = x := + (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm_apply_apply x lemma gradient_inner_self (x : EuclideanSpace ℝ (Fin 1)) : gradient (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) x = (2 : ℝ) • x := by refine ext_inner_right (𝕜 := ℝ) fun y => ?_ unfold gradient - rw [InnerProductSpace.toDual_symm_apply] - have hid : DifferentiableAt ℝ (fun y : EuclideanSpace ℝ (Fin 1) => y) x := differentiableAt_id - rw [show (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) = - fun y => ⟪(fun y => y) y, (fun y => y) y⟫_ℝ from rfl] - rw [fderiv_inner_apply (𝕜 := ℝ) hid hid] - simp only [fderiv_fun_id, ContinuousLinearMap.coe_id', id_eq, real_inner_comm, inner_smul_left', - ringHom_apply] - ring + rw [InnerProductSpace.toDual_symm_apply, + fderiv_inner_apply (𝕜 := ℝ) differentiableAt_fun_id differentiableAt_fun_id] + simp [real_inner_comm, inner_smul_right, two_mul] lemma gradient_const_mul_inner_self (c : ℝ) (x : EuclideanSpace ℝ (Fin 1)) : gradient (fun y : EuclideanSpace ℝ (Fin 1) => c * ⟪y, y⟫_ℝ) x = (2 * c) • x := by - calc - gradient (fun y : EuclideanSpace ℝ (Fin 1) => c * ⟪y, y⟫_ℝ) x - = (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm - (fderiv ℝ (fun y : EuclideanSpace ℝ (Fin 1) => c * ⟪y, y⟫_ℝ) x) := rfl - _ = (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm - (c • fderiv ℝ (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) x) := by - rw [fderiv_const_mul]; fun_prop - _ = c • gradient (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) x := by - simp only [gradient, map_smul] - _ = c • ((2 : ℝ) • x) := by - rw [gradient_inner_self] - _ = (2 * c) • x := by - rw [smul_smul, mul_comm] + unfold gradient + rw [fderiv_const_mul (by fun_prop) c, map_smul] + show c • gradient (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) x = (2 * c) • x + rw [gradient_inner_self, smul_smul, mul_comm] /-! @@ -434,28 +367,27 @@ position and velocity. private lemma gradient_add_const' {f : EuclideanSpace ℝ (Fin 1) → ℝ} {c : ℝ} (x : EuclideanSpace ℝ (Fin 1)) : - gradient (fun y => f y + c) x = gradient f x := by - unfold gradient - rw [fderiv_add_const] + gradient (fun y => f y + c) x = gradient f x := + congrArg (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm (fderiv_add_const c) lemma gradient_lagrangian_position_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) (v : EuclideanSpace ℝ (Fin 1)) : gradient (fun x => lagrangian S t x v) x = - S.k • x := by have h_eq : (fun y : EuclideanSpace ℝ (Fin 1) => lagrangian S t y v) = fun y => (-(1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ + (1 / (2 : ℝ) * S.m * ⟪v, v⟫_ℝ) := by - funext y; unfold lagrangian potentialEnergy; simp only [smul_eq_mul]; ring + funext y; simp only [lagrangian_eq]; ring rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] - ext; simp + module lemma gradient_lagrangian_velocity_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) (v : EuclideanSpace ℝ (Fin 1)) : gradient (lagrangian S t x) v = S.m • v := by have h_eq : (fun y : EuclideanSpace ℝ (Fin 1) => lagrangian S t x y) = fun y => ((1 / (2 : ℝ)) * S.m) * ⟪y, y⟫_ℝ + (-(1 / (2 : ℝ)) * S.k * ⟪x, x⟫_ℝ) := by - funext y; unfold lagrangian potentialEnergy; simp only [smul_eq_mul]; ring + funext y; simp only [lagrangian_eq]; ring change gradient (fun y : EuclideanSpace ℝ (Fin 1) => lagrangian S t x y) v = S.m • v rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] - ext; simp + module /-! @@ -488,8 +420,7 @@ Basic equalities for the variational derivative of the action. lemma gradLagrangian_eq_eulerLagrangeOp (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hq : ContDiff ℝ ∞ xₜ) : gradLagrangian S xₜ = eulerLagrangeOp S.lagrangian xₜ := by - rw [gradLagrangian, - ClassicalMechanics.euler_lagrange_varGradient _ _ hq (S.contDiff_lagrangian _)] + rw [gradLagrangian, euler_lagrange_varGradient _ _ hq (S.contDiff_lagrangian _)] /-! @@ -549,18 +480,13 @@ We now show that the force is equal to `- k x`. /-- The force on the classical harmonic oscillator is `- k x`. -/ lemma force_eq_linear (x : EuclideanSpace ℝ (Fin 1)) : force S x = - S.k • x := by - unfold force potentialEnergy - have hpot : (fun y : EuclideanSpace ℝ (Fin 1) => (1 / (2 : ℝ)) • S.k • ⟪y, y⟫_ℝ) = - fun y => ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ := by + have hpot : potentialEnergy S = fun y : EuclideanSpace ℝ (Fin 1) => + ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ := by funext y - simp [smul_eq_mul, mul_assoc] - rw [hpot] - have hgrad : gradient (fun y : EuclideanSpace ℝ (Fin 1) => ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ) x - = S.k • x := by - simpa [smul_eq_mul, mul_assoc] using - (gradient_const_mul_inner_self (c := (1 / (2 : ℝ)) * S.k) x) - rw [hgrad] - simp [neg_smul] + simp [potentialEnergy, mul_assoc] + unfold force + rw [hpot, gradient_const_mul_inner_self] + module /-! @@ -576,21 +502,8 @@ lemma gradLagrangian_eq_force (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : S.gradLagrangian xₜ = fun t => force S (xₜ t) - S.m • ∂ₜ (∂ₜ xₜ) t := by funext t rw [gradLagrangian_eq_eulerLagrangeOp S xₜ hx, eulerLagrangeOp] - congr - · simp [gradient_lagrangian_position_eq, force_eq_linear] - · conv_lhs => - arg 1 - ext t' - rw [gradient_lagrangian_velocity_eq] - show ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t = S.m • ∂ₜ (∂ₜ xₜ) t - have hd : DifferentiableAt ℝ (∂ₜ xₜ) t := - (deriv_differentiable_of_contDiff xₜ hx).differentiableAt - calc - ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t - = fderiv ℝ (fun t' => S.m • ∂ₜ xₜ t') t 1 := rfl - _ = S.m • (fderiv ℝ (∂ₜ xₜ) t 1) := by - exact congrArg (fun L => L 1) (fderiv_const_smul (c := S.m) (f := ∂ₜ xₜ) hd) - _ = S.m • ∂ₜ (∂ₜ xₜ) t := rfl + simp [gradient_lagrangian_position_eq, gradient_lagrangian_velocity_eq, force_eq_linear, + Time.deriv_smul _ S.m (deriv_differentiable_of_contDiff xₜ hx)] /-! @@ -605,10 +518,8 @@ lemma equationOfMotion_iff_newtons_2nd_law (xₜ : Time → EuclideanSpace ℝ ( S.EquationOfMotion xₜ ↔ (∀ t, S.m • ∂ₜ (∂ₜ xₜ) t = force S (xₜ t)) := by rw [EquationOfMotion, gradLagrangian_eq_force S xₜ hx, funext_iff] - simp only [Pi.zero_apply] - conv_lhs => - enter [x] - rw [sub_eq_zero, eq_comm] + simp only [Pi.zero_apply, sub_eq_zero] + exact forall_congr' fun t => eq_comm /-! @@ -633,12 +544,10 @@ the equation of motion. lemma energy_conservation_of_equationOfMotion (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) (h : S.EquationOfMotion xₜ) : ∂ₜ (S.energy xₜ) = 0 := by - rw [energy_deriv _ _ hx] rw [equationOfMotion_iff_newtons_2nd_law _ _ hx] at h - funext x - simp only [Pi.zero_apply] - rw [h] - simp [force_eq_linear] + funext t + rw [energy_deriv _ _ hx] + simp [h, force_eq_linear] /-! @@ -651,19 +560,12 @@ We prove that the energy is constant for any trajectory satisfying the equation lemma energy_conservation_of_equationOfMotion' (xₜ : Time → EuclideanSpace ℝ (Fin 1)) (hx : ContDiff ℝ ∞ xₜ) (h : S.EquationOfMotion xₜ) (t : Time) : S.energy xₜ t = S.energy xₜ 0 := by - have h1 := S.energy_conservation_of_equationOfMotion xₜ hx h - unfold Time.deriv at h1 - apply is_const_of_fderiv_eq_zero (𝕜 := ℝ) - · exact energy_differentiable S xₜ hx + apply is_const_of_fderiv_eq_zero (𝕜 := ℝ) (energy_differentiable S xₜ hx) intro t ext p - simp only [_root_.zero_apply] - have hp : p = p.val • 1 := by ext; simp - rw [hp] - simp only [map_smul, smul_eq_mul, mul_eq_zero] - right - rw [funext_iff] at h1 - simpa using h1 t + rw [p.eq_one_smul, map_smul, ← Time.deriv_eq, + S.energy_conservation_of_equationOfMotion xₜ hx h] + simp /-! @@ -709,8 +611,8 @@ An simple equality for the canonical momentum. lemma toCanonicalMomentum_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) (v : EuclideanSpace ℝ (Fin 1)) : - toCanonicalMomentum S t x v = S.m • v := by - simp [toCanonicalMomentum, gradient_lagrangian_velocity_eq] + toCanonicalMomentum S t x v = S.m • v := + gradient_lagrangian_velocity_eq S t x v /-! @@ -743,7 +645,6 @@ lemma hamiltonian_eq : funext t x p simp only [hamiltonian, toCanonicalMomentum, lagrangian_eq, one_div, LinearEquiv.coe_symm_mk', inner_smul_right, inner_smul_left, map_inv₀, ringHom_apply] - have hm : S.m ≠ 0 := by exact m_ne_zero S field_simp ring @@ -758,19 +659,7 @@ We show that the Hamiltonian is smooth in all its arguments. @[fun_prop] lemma hamiltonian_contDiff (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.hamiltonian := by rw [hamiltonian_eq] - apply ContDiff.add - · apply ContDiff.mul - · apply ContDiff.mul - · exact contDiff_const - · exact contDiff_const - · exact ContDiff.inner (𝕜 := ℝ) (contDiff_fst.comp contDiff_snd) - (contDiff_fst.comp contDiff_snd) - · apply ContDiff.mul - · apply ContDiff.mul - · exact contDiff_const - · exact contDiff_const - · exact ContDiff.inner (𝕜 := ℝ) (contDiff_snd.comp contDiff_snd) - (contDiff_snd.comp contDiff_snd) + fun_prop /-! @@ -786,16 +675,12 @@ lemma gradient_hamiltonian_position_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1 have h_eq : (fun y : EuclideanSpace ℝ (Fin 1) => hamiltonian S t p y) = fun y => ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ + ((1 / (2 : ℝ)) * (1 / S.m) * ⟪p, p⟫_ℝ) := by - funext y; unfold hamiltonian; simp only [toCanonicalMomentum, lagrangian, one_div, - inner_self_eq_norm_sq_to_K, ringHom_apply, potentialEnergy, smul_eq_mul, - LinearEquiv.coe_symm_mk', inner_smul_right, norm_smul, norm_inv, norm_eq_abs] - have hm : S.m ≠ 0 := m_ne_zero S - field_simp - ring_nf - simp [mul_two] + funext y + simp only [hamiltonian_eq] + ring change gradient (fun y : EuclideanSpace ℝ (Fin 1) => hamiltonian S t p y) x = S.k • x rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] - ext; simp + module lemma gradient_hamiltonian_momentum_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) (p : EuclideanSpace ℝ (Fin 1)) : @@ -803,16 +688,11 @@ lemma gradient_hamiltonian_momentum_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1 have h_eq : (fun y : EuclideanSpace ℝ (Fin 1) => hamiltonian S t y x) = fun y => ((1 / (2 : ℝ)) * (1 / S.m)) * ⟪y, y⟫_ℝ + ((1 / (2 : ℝ)) * S.k * ⟪x, x⟫_ℝ) := by - funext y; unfold hamiltonian; simp only [toCanonicalMomentum, lagrangian, one_div, - inner_self_eq_norm_sq_to_K, ringHom_apply, potentialEnergy, smul_eq_mul, - LinearEquiv.coe_symm_mk', inner_smul_right, norm_smul, norm_inv, norm_eq_abs] - have hm : S.m ≠ 0 := m_ne_zero S - field_simp - ring_nf - simp [mul_two] + funext y + simp only [hamiltonian_eq] change gradient (fun y : EuclideanSpace ℝ (Fin 1) => hamiltonian S t y x) p = (1 / S.m) • p rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] - ext; simp + module /-! @@ -826,17 +706,10 @@ This is independent of whether the trajectory satisfies the equations of motion lemma hamiltonian_eq_energy (xₜ : Time → EuclideanSpace ℝ (Fin 1)) : (fun t => hamiltonian S t (toCanonicalMomentum S t (xₜ t) (∂ₜ xₜ t)) (xₜ t)) = energy S xₜ := by funext t - have hsymm : - (toCanonicalMomentum S t (xₜ t)).symm (S.m • ∂ₜ xₜ t) = ∂ₜ xₜ t := by - rw [← toCanonicalMomentum_eq (S := S) (t := t) (x := xₜ t) (v := ∂ₜ xₜ t)] - exact LinearEquiv.symm_apply_apply (toCanonicalMomentum S t (xₜ t)) (∂ₜ xₜ t) - unfold hamiltonian lagrangian energy kineticEnergy potentialEnergy - simp only [toCanonicalMomentum_eq, inner_smul_left, one_div, smul_eq_mul] - rw [hsymm] - ring_nf - simp only [ringHom_apply, inner_self_eq_norm_sq_to_K, one_div, add_left_inj] + rw [hamiltonian_eq] + unfold energy kineticEnergy potentialEnergy + simp only [toCanonicalMomentum_eq, inner_smul_left, inner_smul_right, smul_eq_mul, ringHom_apply] field_simp - ring /-! @@ -868,17 +741,7 @@ lemma equationOfMotion_iff_hamiltonEqOp_eq_zero (xₜ : Time → EuclideanSpace rw [hamiltonEqOp, hamiltonEqOp_eq_zero_iff_hamiltons_equations] simp [toCanonicalMomentum_eq, gradient_hamiltonian_momentum_eq, gradient_hamiltonian_position_eq] rw [equationOfMotion_iff_newtons_2nd_law _ _ hx] - have hderiv_smul : ∀ t, ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t = S.m • ∂ₜ (∂ₜ xₜ) t := by - intro t - have hd : DifferentiableAt ℝ (∂ₜ xₜ) t := - (deriv_differentiable_of_contDiff xₜ hx).differentiableAt - calc - ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t - = fderiv ℝ (fun t' => S.m • ∂ₜ xₜ t') t 1 := rfl - _ = S.m • (fderiv ℝ (∂ₜ xₜ) t 1) := by - exact congrArg (fun L => L 1) (fderiv_const_smul (c := S.m) (f := ∂ₜ xₜ) hd) - _ = S.m • ∂ₜ (∂ₜ xₜ) t := rfl - simp [hderiv_smul, force_eq_linear] + simp [Time.deriv_smul _ S.m (deriv_differentiable_of_contDiff xₜ hx), force_eq_linear] /-! diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean index 459ab748c..d15bb6c04 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean @@ -401,19 +401,8 @@ The trajectories for any initial conditions are smooth functions of time. lemma trajectory_contDiff (S : HarmonicOscillator) (IC : InitialConditions) {n : WithTop ℕ∞} : ContDiff ℝ n (IC.trajectory S) := by rw [trajectory_eq] - apply ContDiff.add - · apply fun_smul - · change ContDiff ℝ _ (((fun x => cos x) ∘ (fun y => S.ω * y))∘ Time.toRealCLM) - refine ContDiff.comp_continuousLinearMap (ContDiff.comp contDiff_cos ?_) - fun_prop - · fun_prop - · have hx := contDiff_sin (n := n) - apply fun_smul - · change ContDiff ℝ _ (((fun x => sin x / S.ω) ∘ (fun y => S.ω * y))∘ Time.toRealCLM) - refine ContDiff.comp_continuousLinearMap (ContDiff.comp ?_ ?_) - · fun_prop - · fun_prop - · fun_prop + have h : ContDiff ℝ n (Time.val : Time → ℝ) := Time.toRealCLM.contDiff + fun_prop /-! @@ -441,10 +430,8 @@ lemma trajectory_velocity (IC : InitialConditions) : ∂ₜ (IC.trajectory S) = simp only [fderiv_fun_const, Pi.zero_apply, smul_zero, add_zero, neg_smul, _root_.neg_apply, FunLike.coe_smul, Pi.smul_apply, fderiv_val, smul_eq_mul, mul_one] - field_simp - ring_nf - rw [← mul_smul, mul_rotate, NonUnitalRing.mul_assoc] - field_simp [mul_div_assoc, div_self, mul_one, S.ω_ne_zero] + field_simp [S.ω_ne_zero] + module /-! @@ -467,7 +454,6 @@ lemma trajectory_acceleration (IC : InitialConditions) : ∂ₜ (∂ₜ (IC.traj simp only [fderiv_fun_const, Pi.ofNat_apply, smul_zero, add_zero, _root_.neg_apply, FunLike.coe_smul, Pi.smul_apply, ContinuousLinearMap.smulRight_apply, fderiv_val, smul_eq_mul, mul_one, neg_smul] - ring_nf module /-! @@ -499,19 +485,18 @@ The trajectories satisfy the equation of motion for the harmonic oscillator. lemma trajectory_equationOfMotion (IC : InitialConditions) : EquationOfMotion S (IC.trajectory S) := by - have hcont : ContDiff ℝ ∞ (IC.trajectory S) := trajectory_contDiff S IC - rw [EquationOfMotion, gradLagrangian_eq_force (S := S) (xₜ := IC.trajectory S) hcont] + rw [EquationOfMotion, gradLagrangian_eq_force (S := S) (xₜ := IC.trajectory S) + (trajectory_contDiff S IC)] funext t simp only [Pi.zero_apply] rw [trajectory_acceleration, force_eq_linear] ext - have hω : S.ω ≠ 0 := ω_ne_zero S have hωm : S.ω ^ 2 * S.m = S.k := by rw [ω_sq] field_simp [m_ne_zero S] simp [trajectory_eq, smul_add, smul_smul, mul_comm] rw [← hωm] - field_simp [hω] + field_simp [ω_ne_zero S] ring /-! @@ -621,12 +606,8 @@ lemma toInitialConditions_trajectory_at_t₀ (S : HarmonicOscillator) rw [InitialConditions.trajectory_eq, toInitialConditions] ext i simp only [smul_add, PiLp.add_apply, PiLp.smul_apply, PiLp.sub_apply, smul_eq_mul] - have h1 : cos (S.ω * IC.t₀.val) ^ 2 + sin (S.ω * IC.t₀.val) ^ 2 = 1 := - cos_sq_add_sin_sq (S.ω * IC.t₀.val) field_simp [S.ω_ne_zero] - nth_rw 2 [← mul_one (S.ω * IC.x_t₀.ofLp i)] - rw [← h1] - ring + linear_combination (S.ω * IC.x_t₀.ofLp i) * cos_sq_add_sin_sq (S.ω * IC.t₀.val) /-- The trajectory resulting from `toInitialConditions` has the specified velocity `v_t₀` at time `t₀`. -/ @@ -638,12 +619,8 @@ lemma toInitialConditions_velocity_at_t₀ (S : HarmonicOscillator) ext i simp only [neg_smul, smul_add, PiLp.add_apply, PiLp.neg_apply, PiLp.smul_apply, PiLp.sub_apply, smul_eq_mul] - have h1 : cos (S.ω * IC.t₀.val) ^ 2 + sin (S.ω * IC.t₀.val) ^ 2 = 1 := - cos_sq_add_sin_sq (S.ω * IC.t₀.val) field_simp [S.ω_ne_zero] - nth_rw 3 [← mul_one (IC.v_t₀.ofLp i)] - rw [← h1] - ring + linear_combination (IC.v_t₀.ofLp i) * cos_sq_add_sin_sq (S.ω * IC.t₀.val) /-- The energy of the trajectory at time `t₀` equals the energy computed from the initial conditions at `t₀`. -/ @@ -653,8 +630,7 @@ lemma toInitialConditions_energy_at_t₀ (S : HarmonicOscillator) 1/2 * (S.m * ‖IC.v_t₀‖^2 + S.k * ‖IC.x_t₀‖^2) := by unfold energy kineticEnergy potentialEnergy simp only [toInitialConditions_trajectory_at_t₀, toInitialConditions_velocity_at_t₀] - rw [real_inner_self_eq_norm_sq, real_inner_self_eq_norm_sq] - simp only [smul_eq_mul] + simp only [real_inner_self_eq_norm_sq, smul_eq_mul] ring end InitialConditionsAtTime @@ -872,14 +848,8 @@ lemma toInitialConditions_fromInitialConditions (S : HarmonicOscillator) have hω : S.ω ≠ 0 := S.ω_ne_zero set z : ℂ := (⟨IC.x₀ 0, IC.v₀ 0 / S.ω⟩ : ℂ) -- polar identities - have hcos : ‖z‖ * cos (Complex.arg z) = z.re := by - rcases eq_or_ne z 0 with h | h - · simp [h] - · rw [Complex.cos_arg h]; field_simp - have hsin : ‖z‖ * sin (Complex.arg z) = z.im := by - rcases eq_or_ne z 0 with h | h - · simp [h] - · rw [Complex.sin_arg]; field_simp + have hcos : ‖z‖ * cos (Complex.arg z) = z.re := Complex.norm_mul_cos_arg z + have hsin : ‖z‖ * sin (Complex.arg z) = z.im := Complex.norm_mul_sin_arg z -- By construction the parts of `z` are exactly the original data. have hre : z.re = IC.x₀ 0 := rfl have him : z.im = IC.v₀ 0 / S.ω := rfl @@ -962,25 +932,7 @@ lemma trajectory_velocity_eq_zero_iff_sin_eq_zero (IC : InitialConditions) ∂ₜ (IC.trajectory S) t = 0 ↔ sin (S.ω * t.val - (AmplitudePhase.fromInitialConditions S IC).φ) = 0 := by rw [trajectory_velocity_eq_sin] - constructor - · intro h - have hscalar : - -((AmplitudePhase.fromInitialConditions S IC).A * S.ω * - sin (S.ω * t.val - (AmplitudePhase.fromInitialConditions S IC).φ)) = 0 := by - simpa using congrArg (fun x : EuclideanSpace ℝ (Fin 1) => x 0) h - have hprod : - (AmplitudePhase.fromInitialConditions S IC).A * S.ω * - sin (S.ω * t.val - (AmplitudePhase.fromInitialConditions S IC).φ) = 0 := by - simpa only [neg_eq_zero] using hscalar - rcases mul_eq_zero.mp hprod with hAω | hsin - · rcases mul_eq_zero.mp hAω with hA0 | hω - · exact (hA hA0).elim - · exact (S.ω_ne_zero hω).elim - · exact hsin - · intro h - ext i - fin_cases i - simp [h] + simp [hA, S.ω_ne_zero] /-- For nonzero amplitude, the velocity is zero exactly at phase times `φ + nπ`. -/ lemma trajectory_velocity_eq_zero_iff_exists_int (IC : InitialConditions) @@ -993,22 +945,13 @@ lemma trajectory_velocity_eq_zero_iff_exists_int (IC : InitialConditions) constructor · intro h obtain ⟨n, hn⟩ := Real.sin_eq_zero_iff.mp h - use n - have hω : S.ω ≠ 0 := S.ω_ne_zero - have ht : - S.ω * t.val = (AmplitudePhase.fromInitialConditions S IC).φ + n * π := by - linarith - calc - (t : ℝ) = (S.ω * t) / S.ω := by field_simp [hω] - _ = ((AmplitudePhase.fromInitialConditions S IC).φ + n * π) / S.ω := by - rw [ht] - · intro h - obtain ⟨n, hn⟩ := h - rw [Real.sin_eq_zero_iff] - use n - have hω : S.ω ≠ 0 := S.ω_ne_zero - rw [hn] - field_simp [hω] + refine ⟨n, ?_⟩ + rw [eq_div_iff S.ω_ne_zero, mul_comm] + linarith + · rintro ⟨n, hn⟩ + rw [Real.sin_eq_zero_iff, hn] + refine ⟨n, ?_⟩ + field_simp [S.ω_ne_zero] ring /-! @@ -1030,40 +973,25 @@ lemma trajectory_velocity_eq_zero_iff_norm_eq_amplitude (IC : InitialConditions) ∂ₜ (IC.trajectory S) t = 0 ↔ ‖IC.trajectory S t‖ = (AmplitudePhase.fromInitialConditions S IC).A := by by_cases hA : (AmplitudePhase.fromInitialConditions S IC).A = 0 - · constructor - · intro _ - rw [trajectory_eq_cos] - simp [hA] - · intro _ - rw [trajectory_velocity_eq_sin] - ext i - fin_cases i - simp [hA] - rw [trajectory_velocity_eq_zero_iff_sin_eq_zero S IC hA t] - rw [trajectory_eq_cos] + · rw [trajectory_velocity_eq_sin, trajectory_eq_cos] + simp [hA] + rw [trajectory_velocity_eq_zero_iff_sin_eq_zero S IC hA t, trajectory_eq_cos] set A := (AmplitudePhase.fromInitialConditions S IC).A set θ := S.ω * t.val - (AmplitudePhase.fromInitialConditions S IC).φ show sin θ = 0 ↔ ‖EuclideanSpace.single 0 (A * cos θ)‖ = A have hA' : A ≠ 0 := by simpa [A] using hA - have hA_nonneg : 0 ≤ A := by - show 0 ≤ ‖(⟨IC.x₀ 0, IC.v₀ 0 / S.ω⟩ : ℂ)‖ - exact norm_nonneg _ + have hA_nonneg : 0 ≤ A := norm_nonneg (⟨IC.x₀ 0, IC.v₀ 0 / S.ω⟩ : ℂ) have hA_pos : 0 < A := lt_of_le_of_ne hA_nonneg (Ne.symm hA') constructor · intro hsin - rcases Real.sin_eq_zero_iff_cos_eq.mp hsin with hcos | hcos - · simp [hcos, abs_of_pos hA_pos] - · simp [hcos, abs_of_pos hA_pos] + rcases Real.sin_eq_zero_iff_cos_eq.mp hsin with hcos | hcos <;> + simp [hcos, abs_of_pos hA_pos] · intro hnorm have hnorm' : |A * cos θ| = A := by simpa using hnorm have hcos_abs : |cos θ| = 1 := by - calc - |cos θ| = |A * cos θ| / A := by - rw [abs_mul, abs_of_pos hA_pos] - field_simp [hA'] - _ = A / A := by rw [hnorm'] - _ = 1 := by field_simp [hA'] + rw [abs_mul, abs_of_pos hA_pos] at hnorm' + exact mul_left_cancel₀ hA' (hnorm'.trans (mul_one A).symm) obtain ⟨n, hn⟩ := Real.abs_cos_eq_one_iff.mp hcos_abs exact Real.sin_eq_zero_iff.mpr ⟨n, hn⟩ @@ -1084,19 +1012,7 @@ lemma trajectory_eq_zero_iff_cos_eq_zero (IC : InitialConditions) IC.trajectory S t = 0 ↔ cos (S.ω * t.val - (AmplitudePhase.fromInitialConditions S IC).φ) = 0 := by rw [trajectory_eq_cos] - constructor - · intro h - have hscalar : - (AmplitudePhase.fromInitialConditions S IC).A * - cos (S.ω * t.val - (AmplitudePhase.fromInitialConditions S IC).φ) = 0 := by - simpa using congrArg (fun x : EuclideanSpace ℝ (Fin 1) => x 0) h - rcases mul_eq_zero.mp hscalar with hA0 | hcos - · exact (hA hA0).elim - · exact hcos - · intro h - ext i - fin_cases i - simp [h] + simp [hA] /-- For nonzero amplitude, the trajectory passes through zero exactly at phase times `φ + (2n + 1)π / 2`. -/ @@ -1110,23 +1026,13 @@ lemma trajectory_eq_zero_iff_exists_int (IC : InitialConditions) constructor · intro h obtain ⟨n, hn⟩ := Real.cos_eq_zero_iff.mp h - use n - have hω : S.ω ≠ 0 := S.ω_ne_zero - have ht : - S.ω * t.val = - (AmplitudePhase.fromInitialConditions S IC).φ + (2 * n + 1) * π / 2 := by - linarith - calc - (t : ℝ) = (S.ω * t) / S.ω := by field_simp [hω] - _ = ((AmplitudePhase.fromInitialConditions S IC).φ + (2 * n + 1) * π / 2) / S.ω := by - rw [ht] - · intro h - obtain ⟨n, hn⟩ := h - rw [Real.cos_eq_zero_iff] - use n - have hω : S.ω ≠ 0 := S.ω_ne_zero - rw [hn] - field_simp [hω] + refine ⟨n, ?_⟩ + rw [eq_div_iff S.ω_ne_zero, mul_comm] + linarith + · rintro ⟨n, hn⟩ + rw [Real.cos_eq_zero_iff, hn] + refine ⟨n, ?_⟩ + field_simp [S.ω_ne_zero] ring end InitialConditions @@ -1160,10 +1066,7 @@ scoped notation "T" => HarmonicOscillator.period lemma period_eq : T S = 2 * π / S.ω := rfl -lemma period_pos : 0 < T S := by - have := S.ω_pos - rw [period_eq] - positivity +lemma period_pos : 0 < T S := div_pos (by positivity) S.ω_pos /-! @@ -1214,48 +1117,21 @@ lemma return_time (IC : InitialConditions) (non_trivial : IC.x₀ ≠ 0 ∨ IC.v set vv := inner ℝ IC.v₀ IC.v₀ set xv := inner ℝ IC.x₀ IC.v₀ set det := vv + xx * S.ω^2 - have zero_lt_det : 0 < det := by - cases non_trivial with - | inl hx => - have xx_gt_zero : 0 < xx := by - apply real_inner_self_pos.mpr - exact hx - calc - 0 < xx * S.ω^2 := by bound - _ ≤ ‖IC.v₀‖^2 + xx * S.ω^2 := by bound - _ = vv + xx * S.ω^2 := by rw [← real_inner_self_eq_norm_sq IC.v₀] - _ = det := by rfl - | inr hv => - have vv_gt_zero : 0 < vv := by - apply real_inner_self_pos.mpr - exact hv - calc - 0 < vv := vv_gt_zero - _ ≤ vv + ‖IC.x₀‖^2 * S.ω^2 := by bound - _ = vv + xx * S.ω^2 := by rw [← real_inner_self_eq_norm_sq IC.x₀] - _ = det := by rfl - have det_ne_zero : det ≠ 0 := by bound + have hxx0 : 0 ≤ xx := real_inner_self_nonneg + have hvv0 : 0 ≤ vv := real_inner_self_nonneg + have hω2 : 0 < S.ω ^ 2 := pow_pos S.ω_pos 2 + have zero_lt_det : 0 < det := by + show 0 < vv + xx * S.ω ^ 2 + rcases non_trivial with hx | hv + · nlinarith [real_inner_self_pos.mpr hx] + · nlinarith [real_inner_self_pos.mpr hv] + have det_ne_zero : det ≠ 0 := zero_lt_det.ne' have hxx : c * xx + (s / S.ω) * xv = xx := by - calc - c * xx + (s / S.ω) * xv = (inner ℝ (c • IC.x₀) IC.x₀) + (s / S.ω) * xv := by - rw[real_inner_smul_left] - (inner ℝ (c • IC.x₀) IC.x₀) + (s / S.ω) * xv = - (inner ℝ (c • IC.x₀) IC.x₀) + (s / S.ω) * inner ℝ IC.v₀ IC.x₀ := by - rw [real_inner_comm IC.x₀ IC.v₀] - _ = (inner ℝ (c • IC.x₀) IC.x₀) + inner ℝ ((s / S.ω) • IC.v₀) IC.x₀ := by - rw [real_inner_smul_left IC.v₀] - _ = (inner ℝ (c • IC.x₀ + (s / S.ω) • IC.v₀) IC.x₀) := by rw [inner_add_left] - _ = xx := by rw [htx] + have h := congrArg (inner ℝ IC.x₀) htx + simpa only [inner_add_right, real_inner_smul_right] using h have hvv : - S.ω * s * xv + c * vv = vv := by - calc - - S.ω * s * xv + c * vv = - S.ω * (s * xv) + c * vv := by ring_nf - _ = - S.ω * inner ℝ (s • IC.x₀) IC.v₀ + c * vv := by rw[real_inner_smul_left] - _ = inner ℝ (- S.ω • s • IC.x₀ ) IC.v₀ + c * vv := by rw [← real_inner_smul_left] - _ = inner ℝ (- S.ω • s • IC.x₀ ) IC.v₀ + inner ℝ (c • IC.v₀) IC.v₀ := by - rw [← real_inner_smul_left] - _ = inner ℝ (- S.ω • s • IC.x₀ + c • IC.v₀) IC.v₀ := by rw [inner_add_left] - _ = inner ℝ (-( S.ω • s • IC.x₀) + c • IC.v₀) IC.v₀ := by rw [neg_smul] - _ = vv := by rw [htv] + have h := congrArg (fun w => inner ℝ w IC.v₀) htv + simpa only [inner_add_left, inner_neg_left, real_inner_smul_left, neg_mul, mul_assoc] using h have hcos : 1 = cos (S.ω * t) := by calc 1 = det / det := by simp only [ne_eq, det_ne_zero, not_false_eq_true, div_self] @@ -1269,14 +1145,11 @@ lemma return_time (IC : InitialConditions) (non_trivial : IC.x₀ ≠ 0 ∨ IC.v _ = c * (det / det) := by rfl _ = c := by simp only [ne_eq, det_ne_zero, not_false_eq_true, div_self, mul_one] _ = _ := by rfl - let ⟨n, hn⟩ := (Real.cos_eq_one_iff (S.ω * t)).mp (Eq.symm hcos) - use n - calc - (n : ℝ) * (T S) = (n : ℝ) * (2 * π / S.ω) := by rfl - _ = ((n : ℝ) * (2 * π)) / S.ω := by ring_nf - _ = (S.ω * t) / S.ω := by rw [hn] - _ = t * (S.ω / S.ω) := by ring_nf - _ = t := by simp only [ne_eq, S.ω_ne_zero, not_false_eq_true, div_self, mul_one] + obtain ⟨n, hn⟩ := (Real.cos_eq_one_iff (S.ω * t)).mp hcos.symm + refine ⟨n, ?_⟩ + rw [period_eq] + field_simp [S.ω_ne_zero] + linear_combination hn end HarmonicOscillator end ClassicalMechanics diff --git a/Physlib/ClassicalMechanics/OrbitalMechanics/VisViva.lean b/Physlib/ClassicalMechanics/OrbitalMechanics/VisViva.lean index 82569453a..94e405369 100644 --- a/Physlib/ClassicalMechanics/OrbitalMechanics/VisViva.lean +++ b/Physlib/ClassicalMechanics/OrbitalMechanics/VisViva.lean @@ -42,10 +42,8 @@ noncomputable def speedCircular (sys : VisViva) (cfg : ConfigurationSpace) : ℝ /-- Lemma: the square of the circular orbit speed equals G M / r. -/ lemma speedCircular_sq (sys : VisViva) (cfg : ConfigurationSpace) (hr : 0 < cfg.r) (hG : 0 < sys.G) (hM : 0 < sys.M) : - (speedCircular sys cfg)^2 = sys.G * sys.M / cfg.r := by - simp [speedCircular] - apply Real.sq_sqrt - positivity + (speedCircular sys cfg)^2 = sys.G * sys.M / cfg.r := + Real.sq_sqrt (by positivity) end VisViva end ClassicalMechanics diff --git a/Physlib/ClassicalMechanics/RigidBody/Basic.lean b/Physlib/ClassicalMechanics/RigidBody/Basic.lean index cb3d9861b..f23152493 100644 --- a/Physlib/ClassicalMechanics/RigidBody/Basic.lean +++ b/Physlib/ClassicalMechanics/RigidBody/Basic.lean @@ -54,13 +54,7 @@ noncomputable def inertiaTensor {d : ℕ} (R : RigidBody d) : lemma inertiaTensor_symmetric {d : ℕ} (R : RigidBody d) (i j : Fin d) : R.inertiaTensor i j = R.inertiaTensor j i := by - simp only [inertiaTensor] - congr - funext x - congr 1 - · congr 2 - exact Eq.propIntro (fun a => id (Eq.symm a)) fun a => id (Eq.symm a) - · ring + simp only [inertiaTensor, eq_comm, mul_comm] /-- The kinetic energy of a rigid body. -/ informal_definition kineticEnergy where diff --git a/Physlib/CondensedMatter/TightBindingChain/Basic.lean b/Physlib/CondensedMatter/TightBindingChain/Basic.lean index 60bd6a73d..018aac8ec 100644 --- a/Physlib/CondensedMatter/TightBindingChain/Basic.lean +++ b/Physlib/CondensedMatter/TightBindingChain/Basic.lean @@ -192,13 +192,13 @@ scoped notation "|" n "⟩⟨" m "|" => localizedComp n m lemma localizedComp_apply_localizedState (m n p : Fin T.N) : |m⟩⟨n| |p⟩ = if n = p then |m⟩ else 0 := by rw [localizedComp, LinearMap.coe_mk, AddHom.coe_mk, - orthonormal_iff_ite.mp T.localizedState_orthonormal n p, ite_smul, one_smul, zero_smul] + T.localizedState_orthonormal_eq_ite n p, ite_smul, one_smul, zero_smul] /-- The adjoint of localizedComp |m⟩⟨n| is |n⟩⟨m|. -/ lemma localizedComp_adjoint (m n : Fin T.N) (ψ φ : T.HilbertSpace) : ⟪|m⟩⟨n| ψ, φ⟫_ℂ = ⟪ψ, |n⟩⟨m| φ⟫_ℂ := by - simp only [localizedComp, LinearMap.coe_mk, AddHom.coe_mk] - rw [inner_smul_left, inner_smul_right, inner_conj_symm] + simp only [localizedComp, LinearMap.coe_mk, AddHom.coe_mk, inner_smul_left, inner_smul_right, + inner_conj_symm] ring /-! @@ -224,25 +224,15 @@ noncomputable def hamiltonian : T.HilbertSpace →ₗ[ℂ] T.HilbertSpace := lemma hamiltonian_hermitian (ψ φ : T.HilbertSpace) : ⟪T.hamiltonian ψ, φ⟫_ℂ = ⟪ψ, T.hamiltonian φ⟫_ℂ := by simp only [hamiltonian, LinearMap.sub_apply, LinearMap.smul_apply, LinearMap.coe_sum, - Finset.sum_apply, LinearMap.add_apply] - rw [inner_sub_left, inner_sub_right] + Finset.sum_apply, LinearMap.add_apply, inner_sub_left, inner_sub_right] congr 1 · -- E0 term - simp only [Finset.smul_sum] - rw [sum_inner, inner_sum] - apply Finset.sum_congr rfl - intro n _ - simp only [inner_smul_left_eq_smul, inner_smul_right_eq_smul] - rw [localizedComp_adjoint] + simp only [Finset.smul_sum, sum_inner, inner_sum, inner_smul_left_eq_smul, + inner_smul_right_eq_smul, localizedComp_adjoint] · -- t term - simp only [Finset.smul_sum, smul_add] - rw [sum_inner, inner_sum] - apply Finset.sum_congr rfl - intro n _ - rw [inner_add_left, inner_add_right] - simp only [inner_smul_left_eq_smul, inner_smul_right_eq_smul] - rw [localizedComp_adjoint, localizedComp_adjoint] - ring + simp only [Finset.smul_sum, smul_add, sum_inner, inner_sum, inner_add_left, inner_add_right, + inner_smul_left_eq_smul, inner_smul_right_eq_smul, localizedComp_adjoint] + exact Finset.sum_congr rfl fun n _ => by ring /-! @@ -255,24 +245,10 @@ lemma hamiltonian_hermitian (ψ φ : T.HilbertSpace) : lemma hamiltonian_apply_localizedState (n : Fin T.N) : T.hamiltonian |n⟩ = (T.E0 : ℂ) • |n⟩ - (T.t : ℂ) • (|n + 1⟩ + |n - 1⟩) := by simp only [hamiltonian, LinearMap.sub_apply, LinearMap.smul_apply, LinearMap.coe_sum, - Finset.sum_apply, LinearMap.add_apply, smul_add] - congr - · /- The `|n⟩` term -/ - conv_lhs => enter [2, c]; rw [localizedComp_apply_localizedState] - simp - · rw [← smul_add] - congr - rw [Finset.sum_add_distrib, add_comm] - congr - · /- The `|n + 1⟩` term-/ - conv_lhs => enter [2, c]; rw [localizedComp_apply_localizedState] - simp - · /- The `|n - 1⟩` term -/ - conv_lhs => enter [2, c]; rw [localizedComp_apply_localizedState] - rw [Finset.sum_eq_single (n - 1)] - · simp - · aesop - · simp + Finset.sum_apply, LinearMap.add_apply, smul_add, Finset.sum_add_distrib, + localizedComp_apply_localizedState, ← eq_sub_iff_add_eq, Finset.sum_ite_eq', Finset.mem_univ, + if_true] + module /-! @@ -285,21 +261,10 @@ lemma hamiltonian_apply_localizedState (n : Fin T.N) : result is not true. -/ lemma energy_localizedState (n : Fin T.N) (htn : 1 < T.N) : ⟪|n⟩, T.hamiltonian |n⟩⟫_ℂ = T.E0 := by rw [hamiltonian_apply_localizedState] - simp only [smul_add, inner_sub_right, inner_add_right] - erw [inner_smul_right, inner_smul_right, inner_smul_right] - simp only [localizedState_orthonormal_eq_ite, ↓reduceIte, mul_one, left_eq_add, - Fin.one_eq_zero_iff, mul_ite, mul_zero, sub_eq_self] - split_ifs with h1 h2 - · omega - · omega - · rename_i h2 - have hn : (-1 : Fin T.N) = 0 := by - trans n - n - · nth_rewrite 1 [h2] - exact Eq.symm (sub_sub_cancel_left n 1) - · exact Fin.sub_self - aesop - · simp + simp only [smul_add, inner_sub_right, inner_add_right, inner_smul_right, + localizedState_orthonormal_eq_ite, ↓reduceIte, mul_one, left_eq_add, eq_sub_iff_add_eq, + add_eq_left, Fin.one_eq_zero_iff, mul_ite, mul_zero, sub_eq_self] + simp [show T.N ≠ 1 from by omega] /-! @@ -350,20 +315,10 @@ lemma quantaWaveNumber_subset_brillouinZone : T.QuantaWaveNumber ⊆ T.Brillouin have hx2' : (x : ℝ) ≤ 2 * ((x / 2 : ℕ) : ℝ) + 1 := by exact_mod_cast (by omega : x ≤ 2 * (x / 2) + 1) refine ⟨?_, ?_⟩ - · apply le_of_eq_of_le (by ring : _ = Real.pi / a * (-1 : ℝ)) - apply le_of_le_of_eq (b := Real.pi / a * (2 * ((n : ℝ) - (x / 2 : ℕ)) / x)) - · apply mul_le_mul_of_nonneg_left - · rw [le_div_iff₀ hx]; linarith [hx2, hn0] - · positivity - · ring - · apply lt_of_lt_of_eq (b := Real.pi / a * (1 : ℝ)) - swap - · ring - apply lt_of_eq_of_lt (b := Real.pi / a * (2 * ((n : ℝ) - (x / 2 : ℕ)) / x)) - · ring - apply mul_lt_mul_of_pos_left - · rw [div_lt_one hx]; linarith [hn, hx2'] - · positivity + · rw [div_mul_eq_mul_div, div_le_div_iff₀ hT (mul_pos hT hx)] + nlinarith [hx2, hn0, mul_pos Real.pi_pos hT] + · rw [div_mul_eq_mul_div, div_lt_div_iff₀ (mul_pos hT hx) hT] + nlinarith [hn, hx2', mul_pos Real.pi_pos hT] /-! @@ -374,20 +329,13 @@ lemma quantaWaveNumber_subset_brillouinZone : T.QuantaWaveNumber ⊆ T.Brillouin lemma quantaWaveNumber_exp_N (n : ℕ) (k : T.QuantaWaveNumber) : Complex.exp (Complex.I * k * n * T.N * T.a) = 1 := by refine Complex.exp_eq_one_iff.mpr ?_ - match k with - | ⟨k, hk⟩ => - obtain ⟨k, rfl⟩ := hk - use ((k : Int) - (T.N / 2 : ℕ)) * (n : ℤ) + obtain ⟨_, m, rfl⟩ := k + use ((m : Int) - (T.N / 2 : ℕ)) * (n : ℤ) have hpp : (T.N : ℂ) ≠ 0 := by simp [Ne.symm (NeZero.ne' T.N)] have hT' : (T.a : ℂ) ≠ 0 := Complex.ne_zero_of_re_pos T.a_pos simp only [Complex.ofReal_mul, Complex.ofReal_div, Complex.ofReal_ofNat, Complex.ofReal_natCast, - Complex.ofReal_sub, Int.natCast_ediv, Nat.cast_ofNat, Int.cast_mul, Int.cast_sub, - Int.cast_natCast] + Complex.ofReal_sub, Int.cast_mul, Int.cast_sub, Int.cast_natCast] field_simp - ring_nf - congr 1 - rw [mul_comm] - rfl lemma quantaWaveNumber_exp_sub_one (n : Fin T.N) (k : T.QuantaWaveNumber) : Complex.exp (Complex.I * k * (n - 1).val * T.a) = @@ -431,9 +379,9 @@ lemma quantaWaveNumber_exp_sub_one (n : Fin T.N) (k : T.QuantaWaveNumber) : lemma quantaWaveNumber_exp_add_one (n : Fin T.N) (k : T.QuantaWaveNumber) : Complex.exp (Complex.I * k * (n + 1).val * T.a) = Complex.exp (Complex.I * k * n * T.a) * Complex.exp (Complex.I * k * T.a) := by - have hn : n = (n + 1) - 1 := by exact Eq.symm (add_sub_cancel_right n 1) conv_rhs => - rw [hn, quantaWaveNumber_exp_sub_one, mul_assoc, ← Complex.exp_add] + rw [show n = (n + 1) - 1 from (add_sub_cancel_right n 1).symm, + quantaWaveNumber_exp_sub_one, mul_assoc, ← Complex.exp_add] simp /-! @@ -471,8 +419,7 @@ lemma energyEigenstate_orthogonal : Pairwise fun k1 k2 => ⟪T.energyEigenstate k1, T.energyEigenstate k2⟫_ℂ = 0 := by intro k1 k2 hne simp only [energyEigenstate, sum_inner] - simp_rw [inner_sum, inner_smul_left, inner_smul_right, - orthonormal_iff_ite.mp T.localizedState_orthonormal] + simp_rw [inner_sum, inner_smul_left, inner_smul_right, localizedState_orthonormal_eq_ite] simp only [mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] set ω := Complex.exp (Complex.I * (k2 - k1) * T.a) with hω_def have hsum_eq : ∑ n : Fin T.N, (starRingEnd ℂ) (Complex.exp (Complex.I * k1 * n * T.a)) * @@ -554,16 +501,12 @@ lemma hamiltonian_energyEigenstate (k : T.QuantaWaveNumber) : rw [energyEigenstate] have hp1 : (∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • |n + 1⟩) = ∑ n : Fin T.N, Complex.exp (Complex.I * k * (n - 1).val * T.a) • |n⟩ := by - let e : Fin T.N ≃ Fin T.N := ⟨fun n => n + 1, fun n => n - 1, fun n => add_sub_cancel_right n 1, - fun n => sub_add_cancel n 1⟩ - conv_rhs => rw [← e.sum_comp] - simp [Equiv.coe_fn_mk, add_sub_cancel_right, e] + conv_rhs => rw [← Equiv.sum_comp (Equiv.addRight (1 : Fin T.N))] + simp [Equiv.coe_addRight, add_sub_cancel_right] have hm1 : (∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • |n - 1⟩) = ∑ n : Fin T.N, Complex.exp (Complex.I * k * (n + 1).val * T.a) • |n⟩ := by - let e : Fin T.N ≃ Fin T.N := ⟨fun n => n - 1, fun n => n + 1, fun n => sub_add_cancel n 1, - fun n => add_sub_cancel_right n 1⟩ - conv_rhs => rw [← e.sum_comp] - simp [Equiv.coe_fn_mk, sub_add_cancel, e] + conv_rhs => rw [← Equiv.sum_comp (Equiv.subRight (1 : Fin T.N))] + simp [Equiv.subRight_apply, sub_add_cancel] calc _ = ∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • T.hamiltonian |n⟩ := by simp _ = ∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • (T.E0 • |n⟩ @@ -573,14 +516,8 @@ lemma hamiltonian_energyEigenstate (k : T.QuantaWaveNumber) : - T.t • ((∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • |n + 1⟩) + (∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • |n - 1⟩)) := by simp only [smul_add, Finset.smul_sum, ← Finset.sum_add_distrib, ← Finset.sum_sub_distrib] - congr - funext n - simp only [smul_sub, smul_add] - congr 1 - · rw [smul_comm] - · rw [smul_comm] - congr 1 - rw [smul_comm] + refine Finset.sum_congr rfl fun n _ => ?_ + module _ = T.E0 • (∑ n : Fin T.N, Complex.exp (Complex.I * k * n * T.a) • |n⟩) - T.t • ((∑ n : Fin T.N, Complex.exp (Complex.I * k * (n - 1).val * T.a) • |n⟩) + (∑ n : Fin T.N, Complex.exp (Complex.I * k * (n + 1).val * T.a) • |n⟩)) := by @@ -591,9 +528,8 @@ lemma hamiltonian_energyEigenstate (k : T.QuantaWaveNumber) : simp [Finset.smul_sum, ← Finset.sum_add_distrib, ← add_smul, sub_smul, ← smul_smul, Finset.sum_sub_distrib] rw [Finset.smul_sum] - congr - funext n - conv_rhs => rw [smul_smul] + refine Finset.sum_congr rfl fun n _ => ?_ + rw [smul_smul] simp only [quantaWaveNumber_exp_sub_one, quantaWaveNumber_exp_add_one, energyEigenvalue, Complex.ofReal_sub, Complex.ofReal_mul, Complex.ofReal_ofNat, Complex.ofReal_cos, Complex.cos.eq_1] diff --git a/Physlib/Cosmology/FLRW/Basic.lean b/Physlib/Cosmology/FLRW/Basic.lean index 864ac0e26..94baa13f9 100644 --- a/Physlib/Cosmology/FLRW/Basic.lean +++ b/Physlib/Cosmology/FLRW/Basic.lean @@ -64,12 +64,10 @@ lemma tendsto_sinh_rx_over_x (r : ℝ) : lemma limit_S_saddle (r : ℝ) : Tendsto (fun k : ℝ => k * Real.sinh (r / k)) atTop (𝓝 r) := by - suffices h_sinh_y : Tendsto (fun y => Real.sinh (r * y) / y) - (map (fun k => 1 / k) atTop) (𝓝 r) by - exact h_sinh_y.congr fun x => by simp [div_eq_mul_inv, mul_comm] - have h_deriv : HasDerivAt (fun y => Real.sinh (r * y)) r 0 := by - simpa using HasDerivAt.sinh (HasDerivAt.const_mul r (hasDerivAt_id 0)) - simpa [div_eq_inv_mul] using h_deriv.tendsto_slope_zero_right + have hg : Tendsto (fun k : ℝ => 1 / k) atTop (𝓝[≠] 0) := by + simpa only [one_div] using tendsto_inv_atTop_nhdsGT_zero.mono_right (nhdsGT_le_nhdsNE 0) + exact ((tendsto_sinh_rx_over_x r).comp hg).congr fun k => by + simp only [Function.comp_apply, mul_one_div, div_div_eq_mul_div, div_one, mul_comm] /-- The limit of `S (Sphere k) r` as `k → ∞` is equal to `S (Flat) r`. First show that `k * sinh(r / k) = sin(r / k) / (1 / k)` pointwise. -/ @@ -85,15 +83,10 @@ lemma tendsto_sin_rx_over_x (r : ℝ) : lemma limit_S_sphere(r : ℝ) : Tendsto (fun k : ℝ => k * Real.sin (r / k)) atTop (𝓝 r) := by - have h_sin_deriv : Filter.Tendsto (fun x : ℝ => Real.sin x / x) (nhdsWithin 0 {0}ᶜ) (nhds 1) := by - simpa [div_eq_inv_mul] using Real.hasDerivAt_sin 0 |> HasDerivAt.tendsto_slope_zero - by_cases hr : r = 0 - · simp [hr] - · have h_subst : Filter.Tendsto (fun k : ℝ => Real.sin (r / k) / (r / k)) Filter.atTop (𝓝 1) := by - refine h_sin_deriv.comp <| tendsto_inf.mpr - ⟨tendsto_const_nhds.div_atTop tendsto_id, tendsto_principal.mpr - <| eventually_ne_atTop 0 |> Eventually.mono <| by aesop⟩ - convert h_subst.const_mul r using 2 <;> field_simp + have hg : Tendsto (fun k : ℝ => 1 / k) atTop (𝓝[≠] 0) := by + simpa only [one_div] using tendsto_inv_atTop_nhdsGT_zero.mono_right (nhdsGT_le_nhdsNE 0) + exact ((tendsto_sin_rx_over_x r).comp hg).congr fun k => by + simp only [Function.comp_apply, mul_one_div, div_div_eq_mul_div, div_one, mul_comm] end SpatialGeometry @@ -215,8 +208,7 @@ lemma decelerationParameter_eq_one_plus_hubbleConstant (haz : a t ≠ 0) (hd_az : ∂ₜ a t ≠ 0) : decelerationParameter a t = -(1 + ∂ₜ (hubbleConstant a) t / (hubbleConstant a t) ^ 2) := by - rw [deriv_hubbleConstant ha hd_a haz] - simp only [decelerationParameter, hubbleConstant] + rw [deriv_hubbleConstant ha hd_a haz, decelerationParameter, hubbleConstant] field_simp ring @@ -227,8 +219,7 @@ lemma deriv_hubbleConstant_eq_neg_sq_mul (haz : a t ≠ 0) (hd_az : ∂ₜ a t ≠ 0) : ∂ₜ (hubbleConstant a) t = -(hubbleConstant a t) ^ 2 * (1 + decelerationParameter a t) := by - rw [deriv_hubbleConstant ha hd_a haz] - simp only [hubbleConstant, decelerationParameter] + rw [deriv_hubbleConstant ha hd_a haz, hubbleConstant, decelerationParameter] field_simp ring @@ -239,11 +230,8 @@ lemma deriv_hubbleConstant_neg_iff (ha : DifferentiableAt ℝ a t) (hd_a : DifferentiableAt ℝ (∂ₜ a) t) (haz : a t ≠ 0) (hd_az : ∂ₜ a t ≠ 0) : ∂ₜ (hubbleConstant a) t < 0 ↔ -1 < decelerationParameter a t := by - have hH : hubbleConstant a t ≠ 0 := hubbleConstant_ne_zero hd_az haz - have hHsq : 0 < (hubbleConstant a t) ^ 2 := - (sq_nonneg _).lt_of_ne (Ne.symm (pow_ne_zero _ hH)) rw [deriv_hubbleConstant_eq_neg_sq_mul ha hd_a haz hd_az] - constructor <;> intro h <;> nlinarith + constructor <;> intro h <;> nlinarith [sq_pos_iff.mpr (hubbleConstant_ne_zero hd_az haz)] /-- There exists a time at which `∂ₜ H < 0` iff there exists a time with `q > -1`. diff --git a/Physlib/Electromagnetism/Distributional/MagneticField.lean b/Physlib/Electromagnetism/Distributional/MagneticField.lean index d261b42a9..90e973906 100644 --- a/Physlib/Electromagnetism/Distributional/MagneticField.lean +++ b/Physlib/Electromagnetism/Distributional/MagneticField.lean @@ -99,8 +99,7 @@ lemma magneticFieldMatrix_basis_repr_eq_vector_potential {c : SpeedOfLight} (A.magneticFieldMatrix c ε) (i, j) = Space.distSpaceDeriv j (A.vectorPotential c) ε i - Space.distSpaceDeriv i (A.vectorPotential c) ε j := by - rw [magneticFieldMatrix_eq_vectorPotential] - simp + simp [magneticFieldMatrix_eq_vectorPotential] lemma magneticFieldMatrix_distSpaceDeriv_basis_repr_eq_vector_potential {c : SpeedOfLight} (A : DistElectromagneticPotential d) @@ -147,8 +146,7 @@ lemma magneticFieldMatrix_one_dim_eq_zero {c : SpeedOfLight} (A : DistElectromagneticPotential 1) : A.magneticFieldMatrix c = 0 := by ext ε - rw [magneticFieldMatrix_eq_vectorPotential] - simp + simp [magneticFieldMatrix_eq_vectorPotential] end DistElectromagneticPotential end Electromagnetism diff --git a/Physlib/Electromagnetism/Distributional/ScalarPotential.lean b/Physlib/Electromagnetism/Distributional/ScalarPotential.lean index 24c4b0948..358e7401c 100644 --- a/Physlib/Electromagnetism/Distributional/ScalarPotential.lean +++ b/Physlib/Electromagnetism/Distributional/ScalarPotential.lean @@ -66,10 +66,7 @@ noncomputable def scalarPotential {d} (c : SpeedOfLight) : simp [distTimeSlice] map_smul' r A := by ext ε - simp only [distTimeSlice, map_smul, ContinuousLinearEquiv.coe_mk, LinearEquiv.coe_mk, - LinearMap.coe_mk, AddHom.coe_mk, ContinuousLinearMap.coe_comp, FunLike.coe_smul, - Function.comp_apply, Pi.smul_apply, smul_eq_mul, Real.ringHom_apply] - ring + simp [distTimeSlice, mul_left_comm] end DistElectromagneticPotential end Electromagnetism diff --git a/Physlib/Electromagnetism/Distributional/VectorPotential.lean b/Physlib/Electromagnetism/Distributional/VectorPotential.lean index 433c6d544..010d08a3b 100644 --- a/Physlib/Electromagnetism/Distributional/VectorPotential.lean +++ b/Physlib/Electromagnetism/Distributional/VectorPotential.lean @@ -63,14 +63,9 @@ noncomputable def vectorPotential {d} (c : SpeedOfLight) : (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) where toFun A := Lorentz.Vector.spatialCLM d ∘L distTimeSlice c A map_add' A₁ A₂ := by - ext ε simp [distTimeSlice] map_smul' r A := by - ext ε i - simp only [distTimeSlice, map_smul, ContinuousLinearEquiv.coe_mk, LinearEquiv.coe_mk, - LinearMap.coe_mk, AddHom.coe_mk, FunLike.coe_smul, ContinuousLinearMap.coe_comp, - Pi.smul_apply, Function.comp_apply, - Real.ringHom_apply, PiLp.smul_apply, smul_eq_mul] + simp [distTimeSlice] end DistElectromagneticPotential diff --git a/Physlib/Electromagnetism/Dynamics/KineticTerm.lean b/Physlib/Electromagnetism/Dynamics/KineticTerm.lean index b9a583038..0a4c339f0 100644 --- a/Physlib/Electromagnetism/Dynamics/KineticTerm.lean +++ b/Physlib/Electromagnetism/Dynamics/KineticTerm.lean @@ -105,8 +105,7 @@ lemma kineticTerm_equivariant {d} {𝓕 : FreeSpace} (A : ElectromagneticPotenti rw [kineticTerm, kineticTerm] conv_lhs => enter [2] - rw [toFieldStrength_equivariant A Λ hf, Tensorial.toTensor_smul] - rw [← actionT_coMetric Λ] + rw [toFieldStrength_equivariant A Λ hf, Tensorial.toTensor_smul, ← actionT_coMetric Λ] simp only [prodT_equivariant, contrT_equivariant, toField_equivariant] /-! @@ -180,112 +179,46 @@ lemma kineticTerm_eq_sum_fieldStrengthMatrix_sq {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, η μ μ * η ν ν * ‖A.fieldStrengthMatrix x (μ, ν)‖ ^ 2 := by rw [kineticTerm_eq_sum_fieldStrengthMatrix] - congr - funext μ - congr - funext ν - rw [Finset.sum_eq_single μ] - · rw [Finset.sum_eq_single ν] - · simp - ring - · intro b _ hb - nth_rewrite 2 [minkowskiMatrix.off_diag_zero] - simp only [mul_zero, zero_mul] - exact id (Ne.symm hb) - · simp - · intro b _ hb - rw [Finset.sum_eq_zero] - intro ν' _ - rw [minkowskiMatrix.off_diag_zero] - simp only [zero_mul] - exact id (Ne.symm hb) - · simp + congr 1 + refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ + rw [Finset.sum_eq_single μ (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) + (by simp), + Finset.sum_eq_single ν (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) + (by simp)] + simp [← pow_two, mul_assoc] lemma kineticTerm_eq_sum_potential {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = - 1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) := by calc _ - _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * - (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) - * (η μ' μ' * ∂_ μ' A x ν' - η ν' ν' * ∂_ ν' A x μ') := by - rw [kineticTerm_eq_sum] - congr 1 - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - apply Finset.sum_congr rfl (fun μ' _ => ?_) - apply Finset.sum_congr rfl (fun ν' _ => ?_) - rw [toFieldStrength_basis_repr_apply_eq_single, toFieldStrength_basis_repr_apply_eq_single] - _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', η μ μ' * η ν ν * - (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) - * (η μ' μ' * ∂_ μ' A x ν - η ν ν * ∂_ ν A x μ') := by - congr 1 - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - apply Finset.sum_congr rfl (fun μ' _ => ?_) - rw [Finset.sum_eq_single ν] - · intro b _ hb - nth_rewrite 2 [minkowskiMatrix.off_diag_zero] - simp only [mul_zero, zero_mul] - exact id (Ne.symm hb) - · simp _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, η μ μ * η ν ν * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) := by + rw [kineticTerm_eq_sum] congr 1 - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - rw [Finset.sum_eq_single μ] - · intro b _ hb - rw [minkowskiMatrix.off_diag_zero] - simp only [zero_mul] - exact id (Ne.symm hb) - · simp - _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, - ((η μ μ) ^ 2 * η ν ν * ∂_ μ A x ν - (η ν ν) ^ 2 * η μ μ * ∂_ ν A x μ) - * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) := by - congr 1 - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - ring - _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, - (η ν ν * ∂_ μ A x ν - η μ μ * ∂_ ν A x μ) - * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) := by simp - _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, - ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - (η ν ν) ^ 2 * ∂_ μ A x ν * ∂_ ν A x μ) + (- - (η μ μ) ^ 2 * ∂_ ν A x μ * ∂_ μ A x ν + η μ μ * η ν ν * (∂_ ν A x μ)^2)) := by - congr 1 - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - ring + refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ + rw [Finset.sum_eq_single μ (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) + (by simp), + Finset.sum_eq_single ν (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) + (by simp), + toFieldStrength_basis_repr_apply_eq_single] _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + - (- ∂_ ν A x μ * ∂_ μ A x ν + η μ μ * η ν ν * (∂_ ν A x μ)^2)) := by simp - _ = - 1 / (4 * 𝓕.μ₀) * ∑ μ, ∑ ν, - ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + - (- ∂_ μ A x ν * ∂_ ν A x μ + η ν ν * η μ μ * (∂_ μ A x ν)^2)) := by + (η ν ν * η μ μ * (∂_ ν A x μ) ^ 2 - ∂_ ν A x μ * ∂_ μ A x ν)) := by congr 1 - conv_lhs => - enter [2, μ]; - rw [Finset.sum_add_distrib] - rw [Finset.sum_add_distrib] - conv_lhs => enter [2]; rw [Finset.sum_comm] - rw [← Finset.sum_add_distrib] - conv_lhs => - enter [2, μ]; - rw [← Finset.sum_add_distrib] - _ = - 1 / (4 * 𝓕.μ₀) * ∑ μ, ∑ ν, - (2 * (η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ)) := by - congr 1 - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - ring + refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ + linear_combination (η μ μ * η ν ν * ∂_ μ A x ν ^ 2 - + 2 * η ν ν * η ν ν * ∂_ μ A x ν * ∂_ ν A x μ) * + minkowskiMatrix.η_apply_mul_η_apply_diag μ + + (η μ μ * η ν ν * ∂_ ν A x μ ^ 2 - 2 * ∂_ μ A x ν * ∂_ ν A x μ) * + minkowskiMatrix.η_apply_mul_η_apply_diag ν _ = - 1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) := by + simp only [Finset.sum_add_distrib] conv_lhs => - enter [2, 2, μ] - rw [← Finset.mul_sum] - rw [← Finset.mul_sum] + enter [2, 2] + rw [Finset.sum_comm] ring /-! @@ -305,11 +238,9 @@ lemma kineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : ElectromagneticPo enter [2, 2, μ, 2, ν, 2, μ', 2, ν'] rw [fieldStrengthMatrix_eq_electric_magnetic A t x hA, fieldStrengthMatrix_eq_electric_magnetic A t x hA] - simp [Fintype.sum_sum_type, Fin.sum_univ_three] - rw [EuclideanSpace.norm_sq_eq, EuclideanSpace.norm_sq_eq] - simp [Fin.sum_univ_three] + simp [Fintype.sum_sum_type, Fin.sum_univ_three, EuclideanSpace.norm_sq_eq] field_simp - simp only [Fin.isValue, FreeSpace.c_sq, one_div, mul_inv_rev] + rw [FreeSpace.c_sq] field_simp ring @@ -318,10 +249,7 @@ lemma kineticTerm_eq_electric_magnetic' {𝓕 : FreeSpace} {A : ElectromagneticP A.kineticTerm 𝓕 x = 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 - (1 / 𝓕.μ₀) * ‖A.magneticField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2) := by - rw [← kineticTerm_eq_electric_magnetic _ _ _ hA] - congr - apply toTimeAndSpace.injective - simp + rw [← kineticTerm_eq_electric_magnetic _ _ _ hA, toTimeAndSpace_symm_apply_time_space] /-! @@ -369,9 +297,8 @@ lemma kineticTerm_eq_electricMatrix_magneticFieldMatrix {𝓕 : FreeSpace} A.kineticTerm 𝓕 x = 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 - (1 / (2 * 𝓕.μ₀)) * ∑ i, ∑ j, ‖A.magneticFieldMatrix 𝓕.c (x.time 𝓕.c) x.space (i, j)‖ ^ 2) := by - rw [← kineticTerm_eq_electricMatrix_magneticFieldMatrix_time_space A (x.time 𝓕.c)] - simp only [toTimeAndSpace_symm_apply_time_space] - exact hA + rw [← kineticTerm_eq_electricMatrix_magneticFieldMatrix_time_space A (x.time 𝓕.c) x.space hA, + toTimeAndSpace_symm_apply_time_space] /-! @@ -382,27 +309,13 @@ lemma kineticTerm_eq_electricMatrix_magneticFieldMatrix {𝓕 : FreeSpace} lemma kineticTerm_const {d} {𝓕 : FreeSpace} (A₀ : Lorentz.Vector d) : kineticTerm 𝓕 ⟨fun _ : SpaceTime d => A₀⟩ = 0 := by funext x - rw [kineticTerm_eq_sum_potential] - conv_lhs => - enter [2, 2, μ, 2, ν] - repeat rw [SpaceTime.deriv_eq] - simp - simp + simp [kineticTerm_eq_sum_potential, SpaceTime.deriv_eq] lemma kineticTerm_add_const {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (A₀ : Lorentz.Vector d) : kineticTerm 𝓕 ⟨fun x => A x + A₀⟩ = kineticTerm 𝓕 A := by funext x - rw [kineticTerm_eq_sum_potential, kineticTerm_eq_sum_potential] - congr - funext μ - congr - funext ν - congr - all_goals - · rw [SpaceTime.deriv_eq] - simp - rfl + simp [kineticTerm_eq_sum_potential, SpaceTime.deriv_eq] /-! @@ -413,25 +326,9 @@ lemma kineticTerm_add_const {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential lemma kineticTerm_contDiff {d} {n : WithTop ℕ∞} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n (A.kineticTerm 𝓕) := by - change ContDiff ℝ n (fun x => A.kineticTerm 𝓕 x) - conv => - enter [3, x] - rw [kineticTerm_eq_sum_fieldStrengthMatrix] - apply ContDiff.mul - · fun_prop - apply ContDiff.sum - intro μ _ - apply ContDiff.sum - intro ν _ - apply ContDiff.sum - intro μ' _ - apply ContDiff.sum - intro ν' _ - apply ContDiff.mul - · apply ContDiff.mul - · fun_prop - exact fieldStrengthMatrix_contDiff hA - exact fieldStrengthMatrix_contDiff hA + rw [funext fun x => kineticTerm_eq_sum_fieldStrengthMatrix (𝓕 := 𝓕) A x] + have h (μν) : ContDiff ℝ n (A.fieldStrengthMatrix · μν) := fieldStrengthMatrix_contDiff hA + fun_prop /-! @@ -449,122 +346,38 @@ lemma kineticTerm_add_time_mul_const {d} {𝓕 : FreeSpace} (A : Electromagnetic have diff_a : ∂_ (Sum.inl 0) (fun x => A x + x (Sum.inl 0) • c) = ∂_ (Sum.inl 0) A + (fun x => c) := by funext x ν - rw [SpaceTime.deriv_eq] - - rw [fderiv_fun_add _ (by fun_prop)] - simp only [Fin.isValue, _root_.add_apply, Lorentz.Vector.apply_add, Pi.add_apply] - congr - rw [fderiv_smul_const (by fun_prop)] - simp [Lorentz.Vector.coordCLM] - exact ha.differentiableAt + rw [SpaceTime.deriv_eq, fderiv_fun_add ha.differentiableAt (by fun_prop), + fderiv_smul_const (by fun_prop)] + simp [Lorentz.Vector.coordCLM, SpaceTime.deriv_eq] have diff_b (i : Fin d) : ∂_ (Sum.inr i) (fun x => A x + x (Sum.inl 0) • c) = ∂_ (Sum.inr i) A := by funext x ν - rw [SpaceTime.deriv_eq] - rw [fderiv_fun_add _ (by fun_prop)] - simp only [Fin.isValue, _root_.add_apply, Lorentz.Vector.apply_add] - rw [fderiv_smul_const (by fun_prop)] - simp only [Fin.isValue, ContinuousLinearMap.smulRight_apply, - Lorentz.Vector.apply_smul] - rw [← SpaceTime.deriv_eq] - simp [Lorentz.Vector.coordCLM] - exact ha.differentiableAt - have hdiff (μ : Fin 1 ⊕ Fin d) : - ∂_ μ (fun x => A x + x (Sum.inl 0) • c) x = - ∂_ μ A x + if μ = Sum.inl 0 then c else 0 := by + rw [SpaceTime.deriv_eq, fderiv_fun_add ha.differentiableAt (by fun_prop), + fderiv_smul_const (by fun_prop)] + simp [Lorentz.Vector.coordCLM, SpaceTime.deriv_eq] + have hdiff (μ ν : Fin 1 ⊕ Fin d) : + ∂_ μ (fun x => A x + x (Sum.inl 0) • c) x ν = + ∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0 := by match μ with | Sum.inl 0 => simp [diff_a] | Sum.inr i => simp [diff_b i] - rw [kineticTerm_eq_sum_potential] - calc _ - _ = -1 / (2 * 𝓕.μ₀) * - ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x + if μ = Sum.inl 0 then c else 0) ν ^ 2 - - (∂_ μ A x + if μ = Sum.inl 0 then c else 0) ν * - (∂_ ν A x + if ν = Sum.inl 0 then c else 0) μ) := by - simp only [hdiff] - _ = -1 / (2 * 𝓕.μ₀) * - ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0) ^ 2 - - (∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0) * - (∂_ ν A x μ + if ν = Sum.inl 0 then c μ else 0)) := by - congr - funext μ - congr - funext ν - congr - all_goals - · simp - split_ifs - simp - rfl - _ = -1 / (2 * 𝓕.μ₀) * - ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + - (if μ = Sum.inl 0 then c ν else 0) * (2 * η μ μ * η ν ν * ∂_ μ A x ν + - η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - - (∂_ μ A x ν) * (if ν = Sum.inl 0 then c μ else 0)) := by - congr - funext μ - congr - funext ν - ring - _ = -1 / (2 * 𝓕.μ₀) * - ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ)) + - -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * - (2 * η μ μ * η ν ν * ∂_ μ A x ν + - η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - - (∂_ μ A x ν) * (if ν = Sum.inl 0 then c μ else 0)) := by - rw [← mul_add] - rw [← Finset.sum_add_distrib] - congr - funext μ - rw [← Finset.sum_add_distrib] - congr - ring_nf - _ = A.kineticTerm 𝓕 x + - -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * - (2 * η μ μ * η ν ν * ∂_ μ A x ν + - η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - - (∂_ μ A x ν) * (if ν = Sum.inl 0 then c μ else 0)) := by - rw [kineticTerm_eq_sum_potential] - _ = A.kineticTerm 𝓕 x + - -1 / (2 * 𝓕.μ₀)* ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * - (2 * η μ μ * η ν ν * ∂_ μ A x ν + - η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - - (∂_ ν A x μ) * (if μ = Sum.inl 0 then c ν else 0)) := by - congr 1 - conv_rhs => - enter [2, 2, μ] - rw [Finset.sum_sub_distrib] - conv_rhs => - rw [Finset.sum_sub_distrib] - enter [2, 2] - rw [Finset.sum_comm] - rw [← Finset.sum_sub_distrib] - conv_rhs => - enter [2, 2, μ] - rw [← Finset.sum_sub_distrib] - _ = A.kineticTerm 𝓕 x + - -1 / (2 * 𝓕.μ₀) * ∑ ν, (c ν * (2 * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν - - (∂_ ν A x (Sum.inl 0)) - (if ν = Sum.inl 0 then c (Sum.inl 0) else 0)) - - (∂_ ν A x (Sum.inl 0)) * c ν) := by - congr 1 - simp - _ = A.kineticTerm 𝓕 x + - -1 / (2 * 𝓕.μ₀) * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - - 2 * c ν * (∂_ ν A x (Sum.inl 0))) - c ν * - (if ν = Sum.inl 0 then c (Sum.inl 0) else 0)) := by - congr - funext ν - ring - _ = A.kineticTerm 𝓕 x + - (-1 / (2 * 𝓕.μ₀) * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - - 2 * c ν * (∂_ ν A x (Sum.inl 0)))) + 1/(2 * 𝓕.μ₀) * c (Sum.inl 0) ^2) := by - simp only [Fin.isValue, mul_ite, mul_zero, Finset.sum_sub_distrib, Finset.sum_ite_eq', - Finset.mem_univ, ↓reduceIte, one_div, add_right_inj] - ring + rw [kineticTerm_eq_sum_potential, kineticTerm_eq_sum_potential] + simp only [hdiff] + have key (μ ν : Fin 1 ⊕ Fin d) : + η μ μ * η ν ν * (∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0) ^ 2 - + (∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0) * + (∂_ ν A x μ + if ν = Sum.inl 0 then c μ else 0) = + (η μ μ * η ν ν * ∂_ μ A x ν ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + + ((if μ = Sum.inl 0 then 2 * (c ν * η μ μ * η ν ν * ∂_ μ A x ν) + + η μ μ * η ν ν * c ν ^ 2 - c ν * ∂_ ν A x μ else 0) - + (if ν = Sum.inl 0 then c μ * ∂_ μ A x ν else 0) - + (if μ = Sum.inl 0 then c ν else 0) * (if ν = Sum.inl 0 then c μ else 0)) := by + split_ifs <;> ring + simp only [key] + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, mul_ite, ite_mul, + mul_zero, zero_mul, inl_0_inl_0, one_mul, mul_one, two_mul, add_mul, mul_add] + ring /-! @@ -612,40 +425,25 @@ lemma gradKineticTerm_eq_sum_fderiv {d} {𝓕 : FreeSpace} (A : ElectromagneticP let F : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d) → (SpaceTime d → Lorentz.Vector d) → SpaceTime d → ℝ := fun (μ, ν) A' x => (η μ μ * η ν ν * ∂_ μ A' x ν ^ 2 - ∂_ μ A' x ν * ∂_ ν A' x μ) - let F' : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d) → (SpaceTime d → ℝ) → - SpaceTime d → Lorentz.Vector d := fun μν => (fun ψ x => - -(fderiv ℝ (fun x' => (fun x' => η μν.1 μν.1 * η μν.2 μν.2 * ψ x') x' * ∂_ μν.1 A x' μν.2) x) - (Lorentz.Vector.basis μν.1) • - Lorentz.Vector.basis μν.2 + - -(fderiv ℝ (fun x' => ∂_ μν.1 A x' μν.2 * - (fun x' => η μν.1 μν.1 * η μν.2 μν.2 * ψ x') x') x) - (Lorentz.Vector.basis μν.1) • Lorentz.Vector.basis μν.2 + - -(-(fderiv ℝ (fun x' => ψ x' * ∂_ μν.2 A x' μν.1) x) (Lorentz.Vector.basis μν.1) • - Lorentz.Vector.basis μν.2 + - -(fderiv ℝ (fun x' => ∂_ μν.1 A x' μν.2 * ψ x') x) (Lorentz.Vector.basis μν.2) • - Lorentz.Vector.basis μν.1)) - have F_hasVarAdjDerivAt (μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) : - HasVarAdjDerivAt (F μν) (F' μν) A := by - have h1 := - HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) - (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) - have h1' := HasVarAdjDerivAt.const_mul _ _ A h1 (c := η μν.1 μν.1 * η μν.2 μν.2) - have h2 := - HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) - (deriv_hasVarAdjDerivAt μν.2 μν.1 A hA) - have h3 := HasVarAdjDerivAt.neg _ _ A h2 - have h4 := HasVarAdjDerivAt.add _ _ _ _ _ h1' h3 - convert h4 - simp [F] - ring - have F_sum_hasVarAdjDerivAt : - HasVarAdjDerivAt (fun A' x => ∑ μ, ∑ ν, F (μ, ν) A' x) (fun ψ x => ∑ μν, F' μν ψ x) A := by - convert HasVarAdjDerivAt.sum _ _ A (hA) (fun i => F_hasVarAdjDerivAt i) - exact Eq.symm (Fintype.sum_prod_type fun x => F x _ _) - have hF_mul := HasVarAdjDerivAt.const_mul _ _ A F_sum_hasVarAdjDerivAt (c := -1/(2 * 𝓕.μ₀)) + have F_h (μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) := + HasVarAdjDerivAt.congr (G := F μν) + (HasVarAdjDerivAt.add _ _ _ _ _ + (HasVarAdjDerivAt.const_mul _ _ A + (HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) + (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA)) (c := η μν.1 μν.1 * η μν.2 μν.2)) + (HasVarAdjDerivAt.neg _ _ A + (HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) + (deriv_hasVarAdjDerivAt μν.2 μν.1 A hA)))) + (fun φ _ => funext fun x => by + simp [F] + ring) + have hF_mul := HasVarAdjDerivAt.const_mul _ _ A + (HasVarAdjDerivAt.congr (G := fun A' x => ∑ μ, ∑ ν, F (μ, ν) A' x) + (HasVarAdjDerivAt.sum _ _ A hA F_h) + (fun φ _ => funext fun x => Fintype.sum_prod_type fun μν => F μν φ x)) + (c := -1/(2 * 𝓕.μ₀)) change HasVarGradientAt (fun A' x => -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, F (μ, ν) A' x) _ A - apply HasVarGradientAt.intro _ hF_mul - rfl + exact HasVarGradientAt.intro _ hF_mul rfl /-! @@ -673,8 +471,7 @@ lemma gradKineticTerm_eq_sum_sum {d} {𝓕 : FreeSpace} • Lorentz.Vector.basis μ)) := by dsimp rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun μ _ => ?_) - refine Finset.sum_congr rfl (fun ν _ => ?_) + refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ simp only [mul_one, neg_smul, neg_add_rev, neg_neg, mul_neg] ring_nf _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), @@ -684,13 +481,8 @@ lemma gradKineticTerm_eq_sum_sum {d} {𝓕 : FreeSpace} Lorentz.Vector.basis ν + (fderiv ℝ (fun x' => -1 / (2 * 𝓕.μ₀) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis ν) • Lorentz.Vector.basis μ) := by - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - rw [← add_smul] - rw [neg_add, ← add_assoc, ← neg_smul, ← add_smul] - congr 1 - · ring_nf - · simp [← neg_smul] + refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ + module _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), ((- 2 * (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis μ) + @@ -701,31 +493,17 @@ lemma gradKineticTerm_eq_sum_sum {d} {𝓕 : FreeSpace} conv_lhs => enter [2]; rw [Finset.sum_comm] rw [← Finset.sum_add_distrib] conv_lhs => enter [2, μ]; rw [← Finset.sum_add_distrib] - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) + refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ rw [← add_smul] ring_nf - _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - ((- 2 * ((η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ (fun x' => ∂_ μ A x' ν) x) + - 2 * ((-1 / (2 * 𝓕.μ₀) * ∂_ μ (fun x' => ∂_ ν A x' μ) x)))) • Lorentz.Vector.basis ν := by - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - congr - · rw [fderiv_const_mul] - simp [SpaceTime.deriv_eq] - fun_prop - · rw [fderiv_const_mul] - simp [SpaceTime.deriv_eq] - fun_prop - _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - ((1 / (𝓕.μ₀) * (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - - ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν) := by - apply Finset.sum_congr rfl (fun μ _ => ?_) - apply Finset.sum_congr rfl (fun ν _ => ?_) - ring_nf _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), (1 / (𝓕.μ₀) * (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - - ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by rw [Finset.sum_comm] + ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun ν _ => Finset.sum_congr rfl fun μ _ => ?_ + rw [fderiv_const_mul (by fun_prop), fderiv_const_mul (by fun_prop)] + simp [SpaceTime.deriv_eq] + ring_nf /-! @@ -754,46 +532,21 @@ lemma gradKineticTerm_eq_fieldStrength {d} {𝓕 : FreeSpace} (A : Electromagnet congr 1 ring_nf simp - _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (fun x' => η μ μ * ∂_ μ A x' ν) x - - ∂_ μ (fun x' => η ν ν * ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by - apply Finset.sum_congr rfl (fun ν _ => ?_) - apply Finset.sum_congr rfl (fun μ _ => ?_) - congr - · rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq, fderiv_const_mul] - rfl - fun_prop - · rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq, fderiv_const_mul] - rfl - fun_prop - _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (fun x' => η μ μ * ∂_ μ A x' ν - - η ν ν * ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by - apply Finset.sum_congr rfl (fun ν _ => ?_) - apply Finset.sum_congr rfl (fun μ _ => ?_) - congr - rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq, SpaceTime.deriv_eq, fderiv_fun_sub] - simp only [FunLike.coe_sub, Pi.sub_apply] - · fun_prop - · fun_prop _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by - apply Finset.sum_congr rfl (fun ν _ => ?_) - apply Finset.sum_congr rfl (fun μ _ => ?_) - congr - funext x - rw [toFieldStrength_basis_repr_apply_eq_single] - _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ((1/𝓕.μ₀ * η ν ν) * - ∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) - • Lorentz.Vector.basis ν := by - apply Finset.sum_congr rfl (fun ν _ => ?_) - rw [← Finset.sum_smul, Finset.mul_sum] + refine Finset.sum_congr rfl fun ν _ => Finset.sum_congr rfl fun μ _ => ?_ + congr 2 + conv_rhs => + simp only [toFieldStrength_basis_repr_apply_eq_single] + rw [SpaceTime.deriv_eq, fderiv_fun_sub (by fun_prop) (by fun_prop), + fderiv_const_mul (by fun_prop), fderiv_const_mul (by fun_prop)] + simp [SpaceTime.deriv_eq] _ = ∑ (ν : (Fin 1 ⊕ Fin d)), (1/𝓕.μ₀ * η ν ν) • (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) - rw [smul_smul] + rw [← Finset.sum_smul, ← Finset.mul_sum, ← smul_smul] /-! @@ -813,11 +566,7 @@ lemma gradKineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : Electromagnet ∑ i, (𝓕.μ₀⁻¹ * (1 / 𝓕.c ^ 2 * ∂ₜ (fun t => A.electricField 𝓕.c t x.space) (x.time 𝓕.c) i- ∑ j, Space.deriv j (A.magneticFieldMatrix 𝓕.c (x.time 𝓕.c) · (j, i)) x.space)) • Lorentz.Vector.basis (Sum.inr i) := by - have hdiff (μ ν) : Differentiable ℝ fun x => (A.fieldStrengthMatrix x) (μ, ν) := by - conv => enter [2, x]; rw [toFieldStrength_basis_repr_apply_eq_single] - fun_prop - rw [gradKineticTerm_eq_fieldStrength A x ha] - rw [Fintype.sum_sum_type, Fin.sum_univ_one] + rw [gradKineticTerm_eq_fieldStrength A x ha, Fintype.sum_sum_type, Fin.sum_univ_one] congr 1 · rw [smul_smul] congr 1 @@ -829,8 +578,7 @@ lemma gradKineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : Electromagnet · congr funext j simp only [one_div, inr_i_inr_i, mul_neg, mul_one, neg_smul] - rw [curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix] - rw [smul_smul, ← neg_smul] + rw [curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix, smul_smul, ← neg_smul] congr simp only [one_div, toTimeAndSpace_symm_apply_time_space, sub_add_cancel_left, mul_neg] apply ha.of_le (ENat.LEInfty.out) @@ -844,11 +592,7 @@ lemma gradKineticTerm_eq_electric_magnetic_three {𝓕 : FreeSpace} (A : Electro Space.curl (A.magneticField 𝓕.c (x.time 𝓕.c)) x.space i)) • Lorentz.Vector.basis (Sum.inr i) := by rw [gradKineticTerm_eq_electric_magnetic A x ha] - congr - funext i - congr - rw [magneticField_curl_eq_magneticFieldMatrix] - exact ha.of_le (ENat.LEInfty.out) + simp only [magneticField_curl_eq_magneticFieldMatrix A (ha.of_le ENat.LEInfty.out)] /-! ### B.5. Linearity properties of the variational gradient @@ -859,10 +603,10 @@ lemma gradKineticTerm_add {d} {𝓕 : FreeSpace} (A1 A2 : ElectromagneticPotenti (hA1 : ContDiff ℝ ∞ A1) (hA2 : ContDiff ℝ ∞ A2) : (A1 + A2).gradKineticTerm 𝓕 = A1.gradKineticTerm 𝓕 + A2.gradKineticTerm 𝓕 := by funext x - rw [gradKineticTerm_eq_fieldStrength] + rw [gradKineticTerm_eq_fieldStrength (A1 + A2) x (hA1.add hA2)] simp only [Pi.add_apply] - rw [gradKineticTerm_eq_fieldStrength, gradKineticTerm_eq_fieldStrength] - rw [← Finset.sum_add_distrib] + rw [gradKineticTerm_eq_fieldStrength A1 x hA1, gradKineticTerm_eq_fieldStrength A2 x hA2, + ← Finset.sum_add_distrib] apply Finset.sum_congr rfl (fun ν _ => ?_) rw [← smul_add, ← add_smul, ← Finset.sum_add_distrib] congr @@ -873,22 +617,18 @@ lemma gradKineticTerm_add {d} {𝓕 : FreeSpace} (A1 A2 : ElectromagneticPotenti rw [fieldStrengthMatrix_add _ _ _ (hA1.differentiable (by simp)) (hA2.differentiable (by simp))] simp [Finsupp.coe_add, Pi.add_apply] - rw [fderiv_fun_add] + rw [fderiv_fun_add + (fieldStrengthMatrix_differentiable (hA1.of_le ENat.LEInfty.out)).differentiableAt + (fieldStrengthMatrix_differentiable (hA2.of_le ENat.LEInfty.out)).differentiableAt] rfl - · apply fieldStrengthMatrix_differentiable <| hA1.of_le (ENat.LEInfty.out) - · apply fieldStrengthMatrix_differentiable <| hA2.of_le (ENat.LEInfty.out) - · exact hA2 - · exact hA1 - · exact hA1.add hA2 lemma gradKineticTerm_smul {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (c : ℝ) : (c • A).gradKineticTerm 𝓕 = c • A.gradKineticTerm 𝓕 := by funext x - rw [gradKineticTerm_eq_fieldStrength] + rw [gradKineticTerm_eq_fieldStrength (c • A) x (hA.const_smul c)] simp only [Pi.smul_apply] - rw [gradKineticTerm_eq_fieldStrength] - rw [Finset.smul_sum] + rw [gradKineticTerm_eq_fieldStrength A x hA, Finset.smul_sum] apply Finset.sum_congr rfl (fun ν _ => ?_) conv_rhs => rw [smul_comm] congr 1 @@ -900,15 +640,12 @@ lemma gradKineticTerm_smul {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential rw [SpaceTime.deriv_eq] change (c • fderiv ℝ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x) (Lorentz.Vector.basis μ) rw [← fderiv_const_smul - (fieldStrengthMatrix_differentiable <| hA.of_le (ENat.LEInfty.out)).differentiableAt] - rw [← SpaceTime.deriv_eq] + (fieldStrengthMatrix_differentiable <| hA.of_le (ENat.LEInfty.out)).differentiableAt, + ← SpaceTime.deriv_eq] congr funext x - rw [fieldStrengthMatrix_smul _ _ _] + rw [fieldStrengthMatrix_smul _ _ _ (hA.differentiable (by simp))] rfl - · exact hA.differentiable (by simp) - · exact hA - · exact hA.const_smul c /-! @@ -927,40 +664,25 @@ lemma kineticTerm_hasVarGradientAt {d} {𝓕 : FreeSpace} (A : ElectromagneticPo let F : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d) → (SpaceTime d → Lorentz.Vector d) → SpaceTime d → ℝ := fun (μ, ν) A' x => (η μ μ * η ν ν * ∂_ μ A' x ν ^ 2 - ∂_ μ A' x ν * ∂_ ν A' x μ) - let F' : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d) → (SpaceTime d → ℝ) → - SpaceTime d → Lorentz.Vector d := fun μν => (fun ψ x => - -(fderiv ℝ (fun x' => (fun x' => η μν.1 μν.1 * η μν.2 μν.2 * ψ x') x' * ∂_ μν.1 A x' μν.2) x) - (Lorentz.Vector.basis μν.1) • - Lorentz.Vector.basis μν.2 + - -(fderiv ℝ (fun x' => ∂_ μν.1 A x' μν.2 * - (fun x' => η μν.1 μν.1 * η μν.2 μν.2 * ψ x') x') x) - (Lorentz.Vector.basis μν.1) • Lorentz.Vector.basis μν.2 + - -(-(fderiv ℝ (fun x' => ψ x' * ∂_ μν.2 A x' μν.1) x) (Lorentz.Vector.basis μν.1) • - Lorentz.Vector.basis μν.2 + - -(fderiv ℝ (fun x' => ∂_ μν.1 A x' μν.2 * ψ x') x) (Lorentz.Vector.basis μν.2) • - Lorentz.Vector.basis μν.1)) - have F_hasVarAdjDerivAt (μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) : - HasVarAdjDerivAt (F μν) (F' μν) A := by - have h1 := - HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) - (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) - have h1' := HasVarAdjDerivAt.const_mul _ _ A h1 (c := η μν.1 μν.1 * η μν.2 μν.2) - have h2 := - HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) - (deriv_hasVarAdjDerivAt μν.2 μν.1 A hA) - have h3 := HasVarAdjDerivAt.neg _ _ A h2 - have h4 := HasVarAdjDerivAt.add _ _ _ _ _ h1' h3 - convert h4 - simp [F] - ring - have F_sum_hasVarAdjDerivAt : - HasVarAdjDerivAt (fun A' x => ∑ μ, ∑ ν, F (μ, ν) A' x) (fun ψ x => ∑ μν, F' μν ψ x) A := by - convert HasVarAdjDerivAt.sum _ _ A (hA) (fun i => F_hasVarAdjDerivAt i) - exact Eq.symm (Fintype.sum_prod_type fun x => F x _ _) - have hF_mul := HasVarAdjDerivAt.const_mul _ _ A F_sum_hasVarAdjDerivAt (c := -1/(2 * 𝓕.μ₀)) + have F_h (μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) := + HasVarAdjDerivAt.congr (G := F μν) + (HasVarAdjDerivAt.add _ _ _ _ _ + (HasVarAdjDerivAt.const_mul _ _ A + (HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) + (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA)) (c := η μν.1 μν.1 * η μν.2 μν.2)) + (HasVarAdjDerivAt.neg _ _ A + (HasVarAdjDerivAt.mul _ _ _ _ A (deriv_hasVarAdjDerivAt μν.1 μν.2 A hA) + (deriv_hasVarAdjDerivAt μν.2 μν.1 A hA)))) + (fun φ _ => funext fun x => by + simp [F] + ring) + have hF_mul := HasVarAdjDerivAt.const_mul _ _ A + (HasVarAdjDerivAt.congr (G := fun A' x => ∑ μ, ∑ ν, F (μ, ν) A' x) + (HasVarAdjDerivAt.sum _ _ A hA F_h) + (fun φ _ => funext fun x => Fintype.sum_prod_type fun μν => F μν φ x)) + (c := -1/(2 * 𝓕.μ₀)) change HasVarGradientAt (fun A' x => -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, F (μ, ν) A' x) _ A - apply HasVarGradientAt.intro _ hF_mul - rfl + exact HasVarGradientAt.intro _ hF_mul rfl /-! diff --git a/Physlib/Electromagnetism/Kinematics/Boosts.lean b/Physlib/Electromagnetism/Kinematics/Boosts.lean index e8359f484..829b52aab 100644 --- a/Physlib/Electromagnetism/Kinematics/Boosts.lean +++ b/Physlib/Electromagnetism/Kinematics/Boosts.lean @@ -71,13 +71,9 @@ lemma electricField_apply_x_boost_zero {d : ℕ} {c : SpeedOfLight} (β : ℝ) ( electricField c (Λ • A) t x 0 = A.electricField c t' x' 0 := by dsimp - rw [electricField_eq_fieldStrengthMatrix, fieldStrengthMatrix_equivariant] - simp [Fintype.sum_sum_type] - rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] - simp only [boost_inr_self_inr_self, Fin.isValue, boost_zero_inr_0_inr_succ, mul_zero, zero_mul, - Finset.sum_const_zero, add_zero, boost_inl_0_inr_self, neg_mul, neg_neg, - fieldStrengthMatrix_diag_eq_zero, boost_zero_inl_0_inr_succ, neg_zero] - rw [electricField_eq_fieldStrengthMatrix] + rw [electricField_eq_fieldStrengthMatrix, fieldStrengthMatrix_equivariant _ _ hA] + simp [Fintype.sum_sum_type, Fin.sum_univ_succ] + rw [electricField_eq_fieldStrengthMatrix (hA := hA)] simp only [Fin.isValue, neg_mul, neg_inj, mul_eq_mul_left_iff, SpeedOfLight.val_ne_zero, or_false] conv_lhs => enter [2] @@ -92,8 +88,6 @@ lemma electricField_apply_x_boost_zero {d : ℕ} {c : SpeedOfLight} (β : ℝ) ( rw [SpaceTime.boost_zero_apply_time_space] field_simp rfl - exact hA - exact hA · fun_prop /-! @@ -115,19 +109,15 @@ lemma electricField_apply_x_boost_succ {d : ℕ} {c : SpeedOfLight} (β : ℝ) ( dsimp rw [electricField_eq_fieldStrengthMatrix, fieldStrengthMatrix_equivariant _ _ hA] - simp [Fintype.sum_sum_type] - rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] - simp [boost_zero_inr_succ_inr_succ] - rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c)] - rw [fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c)] - rw [SpaceTime.boost_zero_apply_time_space] + simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] + rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c) (hA := hA), + fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c), + SpaceTime.boost_zero_apply_time_space] simp only [one_div, Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, SpaceTime.space_toTimeAndSpace_symm, neg_mul, mul_neg] field_simp ring_nf - field_simp rfl - exact hA · fun_prop /-! @@ -152,23 +142,17 @@ lemma magneticFieldMatrix_apply_x_boost_zero_succ {d : ℕ} {c : SpeedOfLight} ( | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩ magneticFieldMatrix c (Λ • A) t x (0, i.succ) = γ β * (A.magneticFieldMatrix c t' x' (0, i.succ) + β / c * A.electricField c t' x' i.succ) := by - dsimp - rw [magneticFieldMatrix_eq] - simp only + dsimp [magneticFieldMatrix_eq] rw [fieldStrengthMatrix_equivariant _ _ hA] - simp [Fintype.sum_sum_type] - rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] - simp [boost_zero_inr_succ_inr_succ] - rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c)] - rw [fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c)] - simp only [one_div, neg_mul, mul_neg, neg_neg] - rw [SpaceTime.boost_zero_apply_time_space] - simp only [Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, - SpaceTime.space_toTimeAndSpace_symm] + simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] + rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c) (hA := hA), + fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c), + SpaceTime.boost_zero_apply_time_space] + simp only [one_div, Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, + SpaceTime.space_toTimeAndSpace_symm, neg_mul, mul_neg, neg_neg] field_simp ring_nf rfl - exact hA /-! @@ -186,9 +170,7 @@ lemma magneticFieldMatrix_apply_x_boost_succ_succ {d : ℕ} {c : SpeedOfLight} ( | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩ magneticFieldMatrix c (Λ • A) t x (i.succ, j.succ) = A.magneticFieldMatrix c t' x' (i.succ, j.succ) := by - dsimp - rw [magneticFieldMatrix_eq] - simp only + dsimp [magneticFieldMatrix_eq] rw [fieldStrengthMatrix_equivariant _ _ hA] simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] rw [SpaceTime.boost_zero_apply_time_space] diff --git a/Physlib/Electromagnetism/Kinematics/EMPotential.lean b/Physlib/Electromagnetism/Kinematics/EMPotential.lean index f15200014..b3da653ce 100644 --- a/Physlib/Electromagnetism/Kinematics/EMPotential.lean +++ b/Physlib/Electromagnetism/Kinematics/EMPotential.lean @@ -79,10 +79,8 @@ attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one @[ext] -lemma eq_of_val_eq (A B : ElectromagneticPotential d) (h : A.val = B.val) : A = B := by - cases A; cases B - simp at h - rw [h] +lemma eq_of_val_eq (A B : ElectromagneticPotential d) (h : A.val = B.val) : A = B := + congrArg ElectromagneticPotential.mk h /-! @@ -217,12 +215,7 @@ lemma ofPotentials_eq_add {d} (c : SpeedOfLight) (ϕ : Time → Space d → ℝ) ext1 x refine Lorentz.Vector.ext_of_apply (fun i => ?_) match i with - | Sum.inl 0 => - simp only [ofPotentials, Fin.isValue, add_val, Pi.add_apply, Lorentz.Vector.apply_add] - simp only [ofScalarPotential, Fin.isValue, ofVectorPotential, add_zero] - | Sum.inr i => - simp only [ofPotentials, add_val, Pi.add_apply, Lorentz.Vector.apply_add] - simp [ofScalarPotential, ofVectorPotential] + | Sum.inl 0 | Sum.inr _ => simp [ofPotentials, ofScalarPotential, ofVectorPotential] /-- The creation of of an electromagnetic potential from static potentials. -/ noncomputable def ofStaticPotentials {d} (c : SpeedOfLight) (ϕ : Space d → ℝ) @@ -232,8 +225,7 @@ noncomputable def ofStaticPotentials {d} (c : SpeedOfLight) (ϕ : Space d → lemma ofStaticPotentials_eq_ofPotentials {d} (c : SpeedOfLight) (ϕ : Space d → ℝ) (A : Space d → EuclideanSpace ℝ (Fin d)) : ofStaticPotentials c ϕ A = ofPotentials c (fun _ => ϕ) (fun _ => A) := by - rw [ofPotentials_eq_add] - rfl + simp [ofStaticPotentials, ofStaticScalarPotential, ofStaticVectorPotential, ofPotentials_eq_add] open MeasureTheory Matrix Space InnerProductSpace Time in /-- The electromagnetic potential from an electric and a magnetic field. @@ -296,37 +288,28 @@ open ContDiff lemma differentiable_component {d : ℕ} (A : ElectromagneticPotential d) (hA : Differentiable ℝ A) (μ : Fin 1 ⊕ Fin d) : Differentiable ℝ (fun x => A x μ) := by - revert μ - rw [SpaceTime.differentiable_vector] - exact hA + exact (SpaceTime.differentiable_vector _).mpr hA μ @[fun_prop] lemma differentiable_action {d} (Λ : LorentzGroup d) (A : ElectromagneticPotential d) (hA : Differentiable ℝ A) : Differentiable ℝ (fun x => Λ • A (Λ⁻¹ • x)) := by - apply Differentiable.comp - · exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM Λ) - · apply Differentiable.comp - · exact hA - · exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM Λ⁻¹) + exact (ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM Λ)).comp + (hA.comp (ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM Λ⁻¹))) @[fun_prop] lemma contDiff_action {d} (Λ : LorentzGroup d) (A : ElectromagneticPotential d) (hA : ContDiff ℝ n A) : ContDiff ℝ n (fun x => Λ • A (Λ⁻¹ • x)) := by - apply ContDiff.comp - · exact ContinuousLinearMap.contDiff (Lorentz.Vector.actionCLM Λ) - · apply ContDiff.comp - · exact hA - · exact ContinuousLinearMap.contDiff (Lorentz.Vector.actionCLM Λ⁻¹) + exact (ContinuousLinearMap.contDiff (Lorentz.Vector.actionCLM Λ)).comp + (hA.comp (ContinuousLinearMap.contDiff (Lorentz.Vector.actionCLM Λ⁻¹))) @[fun_prop] lemma differentiable_deriv {d} {A : ElectromagneticPotential d} (hA : ContDiff ℝ 2 A) (μ ν : Fin 1 ⊕ Fin d) : Differentiable ℝ (fun x => ∂_ μ A x ν) := by - have diff_partial (μ) : - ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by + have h : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by rw [SpaceTime.differentiable_vector] fun_prop - exact diff_partial μ ν + exact h ν @[fun_prop] lemma differentiable_deriv_of_smooth {d} {A : ElectromagneticPotential d} @@ -338,11 +321,10 @@ lemma differentiable_deriv_of_smooth {d} {A : ElectromagneticPotential d} lemma contDiff_deriv {n} {d} {A : ElectromagneticPotential d} (hA : ContDiff ℝ (n + 1) A) (μ ν : Fin 1 ⊕ Fin d) : ContDiff ℝ n (fun x => ∂_ μ A x ν) := by - have diff_partial (μ) : - ∀ ν, ContDiff ℝ n fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by + have h : ∀ ν, ContDiff ℝ n fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by rw [SpaceTime.contDiff_vector] fun_prop - exact diff_partial μ ν + exact h ν TODO "Add results related to the differentiability of the derivative of the Electromagnetic potential." @@ -359,8 +341,7 @@ lemma differentiable_ofScalarPotential {d} (c : SpeedOfLight) (φ : Time → Spa rw [← SpaceTime.differentiable_vector] intro μ match μ with - | Sum.inl 0 => fun_prop - | Sum.inr _ => fun_prop + | Sum.inl 0 | Sum.inr _ => fun_prop lemma contDiff_ofScalarPotential {n} {d} (c : SpeedOfLight) (φ : Time → Space d → ℝ) (hϕ : ContDiff ℝ n ↿φ) : ContDiff ℝ n (ofScalarPotential c φ) := by @@ -368,8 +349,7 @@ lemma contDiff_ofScalarPotential {n} {d} (c : SpeedOfLight) (φ : Time → Space rw [← SpaceTime.contDiff_vector] intro μ match μ with - | Sum.inl 0 => fun_prop - | Sum.inr _ => fun_prop + | Sum.inl 0 | Sum.inr _ => fun_prop lemma differentiable_ofVectorPotential {d} (c : SpeedOfLight) (A : Time → Space d → EuclideanSpace ℝ (Fin d)) @@ -378,8 +358,7 @@ lemma differentiable_ofVectorPotential {d} (c : SpeedOfLight) rw [← SpaceTime.differentiable_vector] intro μ match μ with - | Sum.inl 0 => fun_prop - | Sum.inr i => fun_prop + | Sum.inl 0 | Sum.inr _ => fun_prop lemma contDiff_ofVectorPotential {n} {d} (c : SpeedOfLight) (A : Time → Space d → EuclideanSpace ℝ (Fin d)) @@ -388,8 +367,7 @@ lemma contDiff_ofVectorPotential {n} {d} (c : SpeedOfLight) rw [← SpaceTime.contDiff_vector] intro μ match μ with - | Sum.inl 0 => fun_prop - | Sum.inr i => fun_prop + | Sum.inl 0 | Sum.inr _ => fun_prop lemma differentiable_ofPotentials {d} (c : SpeedOfLight) (φ : Time → Space d → ℝ) (A : Time → Space d → EuclideanSpace ℝ (Fin d)) (hϕ : Differentiable ℝ ↿φ) @@ -398,8 +376,7 @@ lemma differentiable_ofPotentials {d} (c : SpeedOfLight) (φ : Time → Space d rw [← SpaceTime.differentiable_vector] intro μ match μ with - | Sum.inl 0 => fun_prop - | Sum.inr i => fun_prop + | Sum.inl 0 | Sum.inr _ => fun_prop lemma contDiff_ofPotentials {n} {d} (c : SpeedOfLight) (φ : Time → Space d → ℝ) (A : Time → Space d → EuclideanSpace ℝ (Fin d)) (hϕ : ContDiff ℝ n ↿φ) @@ -408,8 +385,7 @@ lemma contDiff_ofPotentials {n} {d} (c : SpeedOfLight) (φ : Time → Space d rw [← SpaceTime.contDiff_vector] intro μ match μ with - | Sum.inl 0 => fun_prop - | Sum.inr i => fun_prop + | Sum.inl 0 | Sum.inr _ => fun_prop open MeasureTheory Matrix Space InnerProductSpace Time in lemma contDiff_ofElectromagneticField {n : ℕ} (c : SpeedOfLight) @@ -497,9 +473,8 @@ lemma hasVarAdjDerivAt_component {d : ℕ} (μ : Fin 1 ⊕ Fin d) (A : SpaceTime · fun_prop refine { adjoint_inner_left := ?_ } intro u v - simp [f, f', inner_smul_left, Lorentz.Vector.basis_inner] - ring_nf - rfl + simp [f, f', inner_smul_left, Lorentz.Vector.basis_inner, Lorentz.Vector.coordCLM_apply] + ring /-! @@ -576,8 +551,7 @@ as taking the derivative and then applying the Lorentz transformation to the res lemma deriv_equivariant {d} {x : SpaceTime d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) (hf : Differentiable ℝ A) : deriv (Λ • A) x = Λ • (deriv A (Λ⁻¹ • x)) := by - rw [deriv_eq_tensorDeriv, deriv_eq_tensorDeriv] - rw [action_val, tensorDeriv_equivariant] + rw [deriv_eq_tensorDeriv, deriv_eq_tensorDeriv, action_val, tensorDeriv_equivariant] all_goals fun_prop /-! @@ -634,8 +608,7 @@ lemma toTensor_deriv_basis_repr_apply {d} (A : ElectromagneticPotential d) (Fin.append ![Color.down] ![Color.up])) : (Tensor.basis _).repr (Tensorial.toTensor (deriv A x)) b = ∂_ (b 0) A x (b 1) := by - rw [Tensorial.basis_toTensor_apply] - rw [Tensorial.basis_map_prod] + rw [Tensorial.basis_toTensor_apply, Tensorial.basis_map_prod] simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, Equiv.symm_symm, Fin.isValue] rw [Lorentz.Vector.tensor_basis_map_eq_basis_reindex, @@ -647,8 +620,7 @@ lemma toTensor_deriv_basis_repr_apply {d} (A : ElectromagneticPotential d) (Lorentz.CoVector.indexEquiv.symm.prodCongr Lorentz.Vector.indexEquiv.symm) := by ext ⟨i, j⟩ simp - rw [hb] - rw [Module.Basis.repr_reindex_apply, deriv_basis_repr_apply] + rw [hb, Module.Basis.repr_reindex_apply, deriv_basis_repr_apply] rfl end ElectromagneticPotential diff --git a/Physlib/Electromagnetism/Kinematics/FieldStrength.lean b/Physlib/Electromagnetism/Kinematics/FieldStrength.lean index 5b53bb856..444207614 100644 --- a/Physlib/Electromagnetism/Kinematics/FieldStrength.lean +++ b/Physlib/Electromagnetism/Kinematics/FieldStrength.lean @@ -113,13 +113,8 @@ lemma toFieldStrength_eq_add {d} (A : ElectromagneticPotential d) (x : SpaceTime Tensorial.toTensor.symm (permT id (IsReindexing.auto) {(η d | μ μ' ⊗ A.deriv x | μ' ν)}ᵀ) - Tensorial.toTensor.symm (permT ![1, 0] (IsReindexing.auto) {(η d | μ μ' ⊗ A.deriv x | μ' ν)}ᵀ) := by - rw [toFieldStrength] - simp only [map_add, map_neg] - rw [sub_eq_add_neg] - apply congrArg₂ - · rfl - · rw [permT_permT] - rfl + simp only [toFieldStrength, map_add, map_neg, sub_eq_add_neg, permT_permT] + rfl lemma toFieldStrength_eq_sub_tensorDeriv {d} {A : ElectromagneticPotential d} (hA : Differentiable ℝ A) (x : SpaceTime d) : @@ -134,8 +129,7 @@ lemma toTensor_toFieldStrength {d} (A : ElectromagneticPotential d) (x : SpaceTi Tensorial.toTensor (toFieldStrength A x) = (permT id (IsReindexing.auto) {(η d | μ μ' ⊗ A.deriv x | μ' ν)}ᵀ) - (permT ![1, 0] (IsReindexing.auto) {(η d | μ μ' ⊗ A.deriv x | μ' ν)}ᵀ) := by - rw [toFieldStrength_eq_add] - simp + simp [toFieldStrength_eq_add] /-! @@ -190,17 +184,10 @@ lemma toFieldStrength_eq_sum_basis_single {d} {A : ElectromagneticPotential d} apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective ext ⟨μ, ν⟩ simp [Basis.tensorProduct_repr_tmul_apply, Finsupp.single_apply] - rw [Finset.sum_eq_single μ, Finset.sum_eq_single ν] - · intro b _ hb - rw [minkowskiMatrix.off_diag_zero] - simp only [zero_mul] - exact id (Ne.symm hb) - · simp - · intro b _ hb - rw [minkowskiMatrix.off_diag_zero] - simp only [zero_mul] - exact id (Ne.symm hb) - · simp + rw [Finset.sum_eq_single μ + (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp), + Finset.sum_eq_single ν + (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp)] /-! @@ -317,8 +304,7 @@ lemma toFieldStrength_tensor_basis_eq_basis {d} (A : ElectromagneticPotential d) (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) b = (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (toFieldStrength A x) (b 0, b 1) := by - rw [Tensorial.basis_toTensor_apply] - rw [Tensorial.basis_map_prod] + rw [Tensorial.basis_toTensor_apply, Tensorial.basis_map_prod] simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, Equiv.symm_symm, Fin.isValue] rw [Lorentz.Vector.tensor_basis_map_eq_basis_reindex] @@ -330,8 +316,7 @@ lemma toFieldStrength_tensor_basis_eq_basis {d} (A : ElectromagneticPotential d) match b with | ⟨i, j⟩ => simp - rw [hb] - rw [Module.Basis.repr_reindex_apply] + rw [hb, Module.Basis.repr_reindex_apply] congr 1 lemma toFieldStrength_basis_repr_apply {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} @@ -350,19 +335,11 @@ lemma toFieldStrength_basis_repr_apply_eq_single {d} {μν : (Fin 1 ⊕ Fin d) (A : ElectromagneticPotential d) (x : SpaceTime d) : (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) μν = ((η μν.1 μν.1 * ∂_ μν.1 A x μν.2) - η μν.2 μν.2 * ∂_ μν.2 A x μν.1) := by - rw [toFieldStrength_basis_repr_apply] - simp only [Finset.sum_sub_distrib] - rw [Finset.sum_eq_single μν.1, Finset.sum_eq_single μν.2] - · intro b _ hb - rw [minkowskiMatrix.off_diag_zero] - simp only [zero_mul] - exact id (Ne.symm hb) - · simp - · intro b _ hb - rw [minkowskiMatrix.off_diag_zero] - simp only [zero_mul] - exact id (Ne.symm hb) - · simp + rw [toFieldStrength_basis_repr_apply, Finset.sum_sub_distrib, + Finset.sum_eq_single μν.1 + (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp), + Finset.sum_eq_single μν.2 + (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp)] /-! @@ -463,33 +440,23 @@ lemma fieldStrengthMatrix_differentiable {d} {A : ElectromagneticPotential d} have diff_partial (μ) : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by rw [SpaceTime.differentiable_vector] - refine Differentiable.clm_apply ?_ ?_ - · exact ((contDiff_succ_iff_fderiv (n := 1)).mp hA).2.2.differentiable - (by simp) - · fun_prop + exact Differentiable.clm_apply + (((contDiff_succ_iff_fderiv (n := 1)).mp hA).2.2.differentiable (by simp)) (by fun_prop) conv => enter [2, x]; rw [toFieldStrength_basis_repr_apply_eq_single, SpaceTime.deriv_eq, SpaceTime.deriv_eq] - apply Differentiable.sub - apply Differentiable.const_mul - · exact diff_partial _ _ - apply Differentiable.const_mul - · exact diff_partial _ _ + exact ((diff_partial _ _).const_mul _).sub ((diff_partial _ _).const_mul _) lemma fieldStrengthMatrix_differentiable_space {d} {A : ElectromagneticPotential d} {μν} (hA : ContDiff ℝ 2 A) (t : Time) {c : SpeedOfLight} : Differentiable ℝ (fun x => A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) μν) := by change Differentiable ℝ ((A.fieldStrengthMatrix · μν) ∘ fun x => (toTimeAndSpace c).symm (t, x)) - refine Differentiable.comp ?_ ?_ - · exact fieldStrengthMatrix_differentiable hA - · fun_prop + exact (fieldStrengthMatrix_differentiable hA).comp (by fun_prop) lemma fieldStrengthMatrix_differentiable_time {d} {A : ElectromagneticPotential d} {μν} (hA : ContDiff ℝ 2 A) (x : Space d) {c : SpeedOfLight} : Differentiable ℝ (fun t => A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) μν) := by change Differentiable ℝ ((A.fieldStrengthMatrix · μν) ∘ fun t => (toTimeAndSpace c).symm (t, x)) - refine Differentiable.comp ?_ ?_ - · exact fieldStrengthMatrix_differentiable hA - · fun_prop + exact (fieldStrengthMatrix_differentiable hA).comp (by fun_prop) lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : ElectromagneticPotential d} {μν} (hA : ContDiff ℝ (n + 1) A) : @@ -504,9 +471,7 @@ lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : Electromagnetic simp only revert ν rw [SpaceTime.contDiff_vector] - apply ContDiff.clm_apply - · exact ContDiff.fderiv_right (m := n) hA (by rfl) - · fun_prop + exact ContDiff.clm_apply (ContDiff.fderiv_right (m := n) hA (by rfl)) (by fun_prop) apply ContDiff.mul · fun_prop · match μν with @@ -514,15 +479,12 @@ lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : Electromagnetic simp only revert μ rw [SpaceTime.contDiff_vector] - apply ContDiff.clm_apply - · exact ContDiff.fderiv_right (m := n) hA (by rfl) - · fun_prop + exact ContDiff.clm_apply (ContDiff.fderiv_right (m := n) hA (by rfl)) (by fun_prop) lemma fieldStrengthMatrix_smooth {d} {A : ElectromagneticPotential d} (hA : ContDiff ℝ ∞ A) (μν) : - ContDiff ℝ ∞ (A.fieldStrengthMatrix · μν) := by - apply fieldStrengthMatrix_contDiff - simpa using hA + ContDiff ℝ ∞ (A.fieldStrengthMatrix · μν) := + fieldStrengthMatrix_contDiff (by simpa using hA) /-! @@ -536,29 +498,25 @@ lemma toFieldStrength_antisymmetric {d} (A : ElectromagneticPotential d) (x : Sp {A.toFieldStrength x | μ ν = - (A.toFieldStrength x | ν μ)}ᵀ := by apply (Tensor.basis _).repr.injective ext b - rw [toTensor_toFieldStrength_basis_repr] - rw [permT_basis_repr_symm_apply, map_neg] + rw [toTensor_toFieldStrength_basis_repr, permT_basis_repr_symm_apply, map_neg] simp only [Nat.reduceAdd, Fin.isValue, Nat.reduceSucc, Finsupp.coe_neg, Pi.neg_apply] - rw [toTensor_toFieldStrength_basis_repr] - rw [← Finset.sum_neg_distrib] - apply Finset.sum_congr rfl (fun κ _ => ?_) + rw [toTensor_toFieldStrength_basis_repr, ← Finset.sum_neg_distrib] + refine Finset.sum_congr rfl fun κ _ => ?_ simp only [Fin.isValue, neg_sub] rfl lemma fieldStrengthMatrix_antisymm {d} (A : ElectromagneticPotential d) (x : SpaceTime d) (μ ν : Fin 1 ⊕ Fin d) : A.fieldStrengthMatrix x (μ, ν) = - A.fieldStrengthMatrix x (ν, μ) := by - rw [toFieldStrength_basis_repr_apply, toFieldStrength_basis_repr_apply] - rw [← Finset.sum_neg_distrib] - apply Finset.sum_congr rfl (fun κ _ => ?_) - simp + rw [toFieldStrength_basis_repr_apply, toFieldStrength_basis_repr_apply, + ← Finset.sum_neg_distrib] + exact Finset.sum_congr rfl fun κ _ => by simp @[simp] lemma fieldStrengthMatrix_diag_eq_zero {d} (A : ElectromagneticPotential d) (x : SpaceTime d) (μ : Fin 1 ⊕ Fin d) : A.fieldStrengthMatrix x (μ, μ) = 0 := by - rw [toFieldStrength_basis_repr_apply_eq_single] - simp + simp [toFieldStrength_basis_repr_apply_eq_single] /-! @@ -593,15 +551,13 @@ lemma fieldStrengthMatrix_equivariant {d} (A : ElectromagneticPotential d) conv_rhs => rw [Finset.sum_comm] apply Finset.sum_congr rfl (fun κ _ => ?_) rw [Lorentz.Vector.smul_eq_sum, Finset.mul_sum] - apply Finset.sum_congr rfl (fun ρ _ => ?_) - ring + exact Finset.sum_congr rfl fun ρ _ => by ring · intro F1 F2 h1 h2 simp [P, h1, h2] rw [← Finset.sum_add_distrib] apply Finset.sum_congr rfl (fun κ _ => ?_) rw [← Finset.sum_add_distrib] - apply Finset.sum_congr rfl (fun ρ _ => ?_) - ring + exact Finset.sum_congr rfl fun ρ _ => by ring /-! @@ -623,20 +579,16 @@ lemma toFieldStrength_add {d} (A1 A2 : ElectromagneticPotential d) apply Finset.sum_congr rfl (fun κ _ => ?_) repeat rw [SpaceTime.deriv_eq] simp only [add_val] - rw [fderiv_add] + rw [fderiv_add hA1.differentiableAt hA2.differentiableAt] simp only [_root_.add_apply, Lorentz.Vector.apply_add] ring - · exact hA1.differentiableAt - · exact hA2.differentiableAt set_option backward.isDefEq.respectTransparency false in lemma fieldStrengthMatrix_add {d} (A1 A2 : ElectromagneticPotential d) (x : SpaceTime d) (hA1 : Differentiable ℝ A1) (hA2 : Differentiable ℝ A2) : (A1 + A2).fieldStrengthMatrix x = A1.fieldStrengthMatrix x + A2.fieldStrengthMatrix x := by - rw [fieldStrengthMatrix, toFieldStrength_add A1 A2 x hA1 hA2] - conv_rhs => rw [fieldStrengthMatrix, fieldStrengthMatrix] - simp + simp [fieldStrengthMatrix, toFieldStrength_add A1 A2 x hA1 hA2] set_option backward.isDefEq.respectTransparency false in lemma toFieldStrength_smul {d} (c : ℝ) (A : ElectromagneticPotential d) @@ -650,18 +602,15 @@ lemma toFieldStrength_smul {d} (c : ℝ) (A : ElectromagneticPotential d) apply Finset.sum_congr rfl (fun κ _ => ?_) repeat rw [SpaceTime.deriv_eq] simp only [smul_val] - rw [fderiv_const_smul] + rw [fderiv_const_smul hA.differentiableAt] simp only [FunLike.coe_smul, Pi.smul_apply, Lorentz.Vector.apply_smul] ring - exact hA.differentiableAt set_option backward.isDefEq.respectTransparency false in lemma fieldStrengthMatrix_smul {d} (c : ℝ) (A : ElectromagneticPotential d) (x : SpaceTime d) (hA : Differentiable ℝ A) : (c • A).fieldStrengthMatrix x = c • A.fieldStrengthMatrix x := by - rw [fieldStrengthMatrix, toFieldStrength_smul c A x hA] - conv_rhs => rw [fieldStrengthMatrix] - simp + simp [fieldStrengthMatrix, toFieldStrength_smul c A x hA] end ElectromagneticPotential diff --git a/Physlib/Electromagnetism/ThreeDimension/Basic.lean b/Physlib/Electromagnetism/ThreeDimension/Basic.lean index 2ebabd84a..6e6125500 100644 --- a/Physlib/Electromagnetism/ThreeDimension/Basic.lean +++ b/Physlib/Electromagnetism/ThreeDimension/Basic.lean @@ -47,15 +47,13 @@ the standard vector-calculus expressions. /-- The electric field written in terms of the scalar and vector potentials as `- ∇ φ - ∂ₜ A`. -/ theorem electricField_eq_3D : - E = fun t x => - ∇ (φ t) x - ∂ₜ (fun t => A t x) t := by - rw [electricField_eq] + E = fun t x => - ∇ (φ t) x - ∂ₜ (fun t => A t x) t := electricField_eq V local notation "B" => V.magneticField c /-- The magnetic field written as the curl of the vector potential as `∇ ⨯ A`. -/ theorem magneticField_eq_3D : - B = fun t x => (∇ ⨯ (A t)) x := by - rw [magneticField_eq] + B = fun t x => (∇ ⨯ (A t)) x := magneticField_eq V end ThreeDimension end Electromagnetism diff --git a/Physlib/Electromagnetism/ThreeDimension/MaxwellEquations.lean b/Physlib/Electromagnetism/ThreeDimension/MaxwellEquations.lean index 8a9ea8fab..830c25544 100644 --- a/Physlib/Electromagnetism/ThreeDimension/MaxwellEquations.lean +++ b/Physlib/Electromagnetism/ThreeDimension/MaxwellEquations.lean @@ -38,13 +38,12 @@ local notation "μ₀" => 𝓕.μ₀ theorem gaussLawElectric (t : Time) (x : Space) (h : IsExtrema 𝓕 V J₄) (hV : ContDiff ℝ ∞ V) (hJ : ContDiff ℝ ∞ J₄) : (∇ ⬝ E t) x = ρ t x / ε₀ := by - rw [((isExtrema_iff_gauss_ampere_magneticFieldMatrix hV J₄ hJ (𝓕 := 𝓕)).mp h t x).1] + exact ((isExtrema_iff_gauss_ampere_magneticFieldMatrix hV J₄ hJ (𝓕 := 𝓕)).mp h t x).1 /-- Gauss's law for the magnetic field. -/ theorem gaussLawMagnetic (t : Time) (x : Space) (hV : ContDiff ℝ ∞ V) : (∇ ⬝ B t) x = 0 := by - rw [magneticField_eq_3D, div_of_curl_eq_zero _ (by fun_prop)] - simp only [Pi.zero_apply] + rw [magneticField_eq_3D, div_of_curl_eq_zero _ (by fun_prop), Pi.zero_apply] /-- Ampère's law. -/ theorem ampereLaw (t : Time) (x : Space) @@ -52,18 +51,15 @@ theorem ampereLaw (t : Time) (x : Space) (∇ ⨯ B t) x = μ₀ • J t x + μ₀ • ε₀ • ∂ₜ (fun t => E t x) t := by ext i have hdE := ((isExtrema_iff_gauss_ampere_magneticFieldMatrix hV J₄ hJ (𝓕 := 𝓕)).mp h t x).2 i - rw [← magneticField_curl_eq_magneticFieldMatrix] at hdE + rw [← magneticField_curl_eq_magneticFieldMatrix _ (hV.of_le ENat.LEInfty.out)] at hdE simp only [PiLp.add_apply, PiLp.smul_apply, smul_eq_mul, ← mul_assoc, hdE, add_sub_cancel] - exact hV.of_le ENat.LEInfty.out /-- Faraday's law. -/ theorem faradayLaw (t : Time) (x : Space) (hV : ContDiff ℝ ∞ V) : (∇ ⨯ E t) x = - ∂ₜ (fun t => B t x) t := by - rw [electricField_eq_3D, magneticField_eq_3D] - change curl ((-(fun t x => ∇ (scalarPotential 𝓕.c V t) x) t - - (fun t x => ∂ₜ (fun t => vectorPotential 𝓕.c V t x) t) t)) x = _ - rw [curl_sub, curl_neg, curl_of_grad_eq_zero, time_deriv_curl_commute] - simp only [neg_zero, Pi.sub_apply, Pi.zero_apply, zero_sub] + rw [electricField_eq_3D, magneticField_eq_3D, fun_curl_sub, fun_curl_neg, + curl_of_grad_eq_zero, time_deriv_curl_commute] + simp only [neg_zero, Pi.zero_apply, zero_sub] all_goals fun_prop end ThreeDimension diff --git a/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean b/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean index bc4fbe15d..dafcdaeee 100644 --- a/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean +++ b/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean @@ -112,7 +112,6 @@ lemma harmonicWaveX_differentiable {d} (𝓕 : FreeSpace) (k : ℝ) | Sum.inr ⟨0, h⟩ => simp | Sum.inr ⟨Nat.succ i, h⟩ => simp [harmonicWaveX] - apply Differentiable.const_mul fun_prop /-! @@ -131,9 +130,7 @@ lemma harmonicWaveX_contDiff {d} (n : WithTop ℕ∞) (𝓕 : FreeSpace) (k : | Sum.inr ⟨0, h⟩ => simp [harmonicWaveX]; fun_prop | Sum.inr ⟨Nat.succ i, h⟩ => simp [harmonicWaveX] - apply ContDiff.mul - · fun_prop - · fun_prop + fun_prop /-! @@ -221,17 +218,14 @@ lemma harmonicWaveX_vectorPotential_succ_space_deriv_zero {d} (𝓕 : FreeSpace) Space.deriv 0 (fun x => vectorPotential 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x i.succ) x = E₀ i / 𝓕.c.val * Real.cos (𝓕.c.val * k * t.val - k * x 0 + φ i) := by simp [harmonicWaveX_vectorPotential_succ] - rw [Space.deriv_eq_fderiv_basis] - rw [fderiv_const_mul (by fun_prop)] + rw [Space.deriv_eq_fderiv_basis, fderiv_const_mul (by fun_prop)] simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] rw [fderiv_sin (by fun_prop)] simp only [fderiv_add_const, FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [fderiv_const_mul (by fun_prop)] - rw [fderiv_const_sub] + rw [fderiv_const_mul (by fun_prop), fderiv_const_sub] simp only [smul_neg, _root_.neg_apply, FunLike.coe_smul, Pi.smul_apply, smul_eq_mul, mul_neg] - rw [← Space.deriv_eq_fderiv_basis] - rw [Space.deriv_component] + rw [← Space.deriv_eq_fderiv_basis, Space.deriv_component] simp only [↓reduceIte, mul_one] field_simp @@ -261,19 +255,14 @@ lemma harmonicWaveX_electricField_succ {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k simp [ElectromagneticPotential.electricField] rw [← Time.deriv_euclid] simp [harmonicWaveX_vectorPotential_succ] - rw [Time.deriv_eq] - rw [fderiv_const_mul] + rw [Time.deriv_eq, fderiv_const_mul (by fun_prop)] simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [fderiv_sin (by fun_prop)] - rw [fderiv_add_const] - rw [fderiv_const_mul (by fun_prop)] + rw [fderiv_sin (by fun_prop), fderiv_add_const, fderiv_const_mul (by fun_prop)] simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [fderiv_sub_const] - rw [fderiv_mul_const (by fun_prop)] + rw [fderiv_sub_const, fderiv_mul_const (by fun_prop)] simp only [FunLike.coe_smul, Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one] field_simp - · fun_prop - · exact vectorPotential_differentiable_time _ (harmonicWaveX_differentiable 𝓕 k E₀ φ) x + exact vectorPotential_differentiable_time _ (harmonicWaveX_differentiable 𝓕 k E₀ φ) x /-! @@ -314,15 +303,13 @@ lemma harmonicWaveX_electricField_succ_time_deriv {d} (𝓕 : FreeSpace) (k : conv_lhs => enter [1, t] rw [harmonicWaveX_electricField_succ _ _ hk] - rw [Time.deriv_eq] - rw [fderiv_const_mul (by fun_prop)] + rw [Time.deriv_eq, fderiv_const_mul (by fun_prop)] simp only [Nat.succ_eq_add_one, FunLike.coe_smul, Pi.smul_apply, smul_eq_mul, neg_mul] rw [fderiv_cos (by fun_prop)] simp only [fderiv_add_const, neg_smul, _root_.neg_apply, FunLike.coe_smul, Pi.smul_apply, smul_eq_mul, mul_neg, neg_inj] - rw [fderiv_sub_const] - rw [fderiv_const_mul (by fun_prop)] + rw [fderiv_sub_const, fderiv_const_mul (by fun_prop)] simp only [FunLike.coe_smul, Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one] ring @@ -337,9 +324,8 @@ lemma harmonicWaveX_div_electricField_eq_zero {d} (𝓕 : FreeSpace) (k : ℝ) ( (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) : Space.div (fun x => electricField 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x) x = 0 := by simp [Space.div] - apply Finset.sum_eq_zero - intro i _ - exact harmonicWaveX_electricField_space_deriv_same 𝓕 k hk E₀ φ t x i + exact Finset.sum_eq_zero fun i _ => + harmonicWaveX_electricField_space_deriv_same 𝓕 k hk E₀ φ t x i /-! @@ -357,36 +343,32 @@ lemma harmonicWaveX_magneticFieldMatrix_succ_succ {d} (𝓕 : FreeSpace) (k : (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i j : Fin d) : (harmonicWaveX 𝓕 k E₀ φ).magneticFieldMatrix 𝓕.c t x (i.succ, j.succ) = 0 := by - rw [magneticFieldMatrix_eq_vectorPotential] + rw [magneticFieldMatrix_eq_vectorPotential _ (harmonicWaveX_differentiable 𝓕 k E₀ φ)] simp only [Nat.succ_eq_add_one, harmonicWaveX_vectorPotential_space_deriv_succ, sub_self] - exact harmonicWaveX_differentiable 𝓕 k E₀ φ lemma harmonicWaveX_magneticFieldMatrix_zero_succ {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d) : (harmonicWaveX 𝓕 k E₀ φ).magneticFieldMatrix 𝓕.c t x (0, i.succ) = (- E₀ i / 𝓕.c.val) * cos (𝓕.c.val * k * t.val - k * x 0 + φ i) := by - rw [magneticFieldMatrix_eq_vectorPotential] + rw [magneticFieldMatrix_eq_vectorPotential _ (harmonicWaveX_differentiable 𝓕 k E₀ φ)] simp only [Nat.succ_eq_add_one, harmonicWaveX_vectorPotential_zero_eq_zero, Space.deriv_const, zero_sub] rw [harmonicWaveX_vectorPotential_succ_space_deriv_zero] simp only [Nat.succ_eq_add_one] ring - grind - exact harmonicWaveX_differentiable 𝓕 k E₀ φ + exact hk lemma harmonicWaveX_magneticFieldMatrix_succ_zero {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d) : (harmonicWaveX 𝓕 k E₀ φ).magneticFieldMatrix 𝓕.c t x (i.succ, 0) = (E₀ i / 𝓕.c.val) * cos (𝓕.c.val * k * t.val - k * x 0 + φ i) := by - rw [magneticFieldMatrix_eq_vectorPotential] + rw [magneticFieldMatrix_eq_vectorPotential _ (harmonicWaveX_differentiable 𝓕 k E₀ φ)] simp only [Nat.succ_eq_add_one, harmonicWaveX_vectorPotential_zero_eq_zero, Space.deriv_const, sub_zero] rw [harmonicWaveX_vectorPotential_succ_space_deriv_zero] - simp only [ne_eq] - grind - exact harmonicWaveX_differentiable 𝓕 k E₀ φ + exact hk /-! @@ -400,6 +382,13 @@ lemma harmonicWaveX_magneticFieldMatrix_space_deriv_succ {d} (𝓕 : FreeSpace) (i j : Fin d.succ) (l : Fin d) : Space.deriv l.succ (fun x => magneticFieldMatrix 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x (i, j)) x = 0 := by + have transverse_deriv_cos_eq_zero : ∀ (C a k b : ℝ) (l : Fin d) (y : Space d.succ), + Space.deriv l.succ (fun x => C * Real.cos (a - k * x 0 + b)) y = 0 := by + intro C a k b l y + rw [Space.deriv_eq, show (fun x : Space d.succ => C * Real.cos (a - k * x 0 + b)) + = (fun u => C * Real.cos (a - k * u + b)) ∘ (fun x => x 0) from rfl, + fderiv_comp _ (by fun_prop) (by fun_prop)] + simp [← Space.deriv_eq, Space.deriv_component, Fin.succ_ne_zero] match i, j with | 0, 0 => simp | ⟨Nat.succ i, hi⟩, ⟨Nat.succ j, hj⟩ => @@ -410,27 +399,12 @@ lemma harmonicWaveX_magneticFieldMatrix_space_deriv_succ {d} (𝓕 : FreeSpace) rw [harmonicWaveX_magneticFieldMatrix_succ_succ _ _] simp | 0, ⟨Nat.succ j, hj⟩ => - have transverse_deriv_cos_eq_zero : ∀ (C a k b : ℝ) (l : Fin d) (y : Space d.succ), - Space.deriv l.succ (fun x => C * Real.cos (a - k * x 0 + b)) y = 0 := by - intro C a k b l y - rw [Space.deriv_eq, show (fun x : Space d.succ => C * Real.cos (a - k * x 0 + b)) - = (fun u => C * Real.cos (a - k * u + b)) ∘ (fun x => x 0) from rfl, - fderiv_comp _ (by fun_prop) (by fun_prop)] - simp [← Space.deriv_eq, Space.deriv_component, Fin.succ_ne_zero] conv_lhs => enter [2, x] rw [← Fin.succ_mk _ _ (by grind)] rw [harmonicWaveX_magneticFieldMatrix_zero_succ _ k hk] apply transverse_deriv_cos_eq_zero - | ⟨Nat.succ j, hj⟩, 0 => - have transverse_deriv_cos_eq_zero : ∀ (C a k b : ℝ) (l : Fin d) (y : Space d.succ), - Space.deriv l.succ (fun x => C * Real.cos (a - k * x 0 + b)) y = 0 := by - intro C a k b l y - rw [Space.deriv_eq, show (fun x : Space d.succ => C * Real.cos (a - k * x 0 + b)) - = (fun u => C * Real.cos (a - k * u + b)) ∘ (fun x => x 0) from rfl, - fderiv_comp _ (by fun_prop) (by fun_prop)] - simp [← Space.deriv_eq, Space.deriv_component, Fin.succ_ne_zero] conv_lhs => enter [2, x] rw [← Fin.succ_mk _ _ (by grind)] @@ -446,8 +420,7 @@ lemma harmonicWaveX_magneticFieldMatrix_zero_succ_space_deriv_zero {d} (𝓕 : F conv_lhs => enter [2, x] rw [harmonicWaveX_magneticFieldMatrix_zero_succ _ k hk] - rw [Space.deriv_eq] - rw [fderiv_const_mul] + rw [Space.deriv_eq, fderiv_const_mul (by fun_prop)] simp only [Nat.succ_eq_add_one, FunLike.coe_smul, Pi.smul_apply, smul_eq_mul, neg_mul] rw [fderiv_cos (by fun_prop)] @@ -457,11 +430,9 @@ lemma harmonicWaveX_magneticFieldMatrix_zero_succ_space_deriv_zero {d} (𝓕 : F simp only [_root_.neg_apply, mul_neg, neg_neg] rw [fderiv_const_mul (by fun_prop)] simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [← Space.deriv_eq] - rw [Space.deriv_component] + rw [← Space.deriv_eq, Space.deriv_component] simp only [↓reduceIte, mul_one] ring - fun_prop /-! @@ -530,8 +501,7 @@ lemma harmonicWaveX_isPlaneWave {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) rw [harmonicWaveX_electricField_succ _ _ hk] simp [planeWave] left - congr - ring + ring_nf · use fun u ij => match ij with | (0, 0) => 0 @@ -553,8 +523,7 @@ lemma harmonicWaveX_isPlaneWave {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) simp only [Nat.succ_eq_add_one, mul_eq_mul_left_iff, div_eq_zero_iff, neg_eq_zero, SpeedOfLight.val_ne_zero, or_false] left - congr - ring + ring_nf | (⟨Nat.succ i, hi⟩, ⟨0, h0⟩) => simp only [Nat.succ_eq_add_one, Fin.zero_eta, inner_basis, neg_mul] rw [← Fin.succ_mk _ _ (by grind)] @@ -562,8 +531,7 @@ lemma harmonicWaveX_isPlaneWave {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) simp only [Nat.succ_eq_add_one, mul_eq_mul_left_iff, div_eq_zero_iff, SpeedOfLight.val_ne_zero, or_false] left - congr - ring + ring_nf | (⟨Nat.succ i, hi⟩, ⟨Nat.succ j, hj⟩) => simp only [Nat.succ_eq_add_one] rw [← Fin.succ_mk _ _ (by grind)] @@ -587,8 +555,7 @@ lemma harmonicWaveX_polarization_ellipse {d} (𝓕 : FreeSpace) (k : ℝ) (hk : have h1 (i : Fin d) : (harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x i.succ / E₀ i = Real.cos (k * 𝓕.c * t.val - k * x 0 + φ i) := by rw [harmonicWaveX_electricField_succ 𝓕 k hk E₀ φ t x i] - specialize hi i - field_simp + field_simp [hi i] conv_lhs => enter [1, 2, 2, i] rw [h1] diff --git a/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean b/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean index eb0811902..aceb3a626 100644 --- a/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean +++ b/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean @@ -93,9 +93,8 @@ lemma electricField_eq_electricFunction {d : ℕ} {𝓕 : FreeSpace} {A : ElectromagneticPotential d} {s : Direction d} (P : IsPlaneWave 𝓕 A s) (t : Time) (x : Space d) : A.electricField 𝓕.c t x = - P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c * t) := by - rw [Classical.choose_spec P.1] - rfl + P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c * t) := + congrFun (congrFun (Classical.choose_spec P.1) t) x /-- The corresponding magnetic field function from `ℝ` to `Fin d × Fin d → ℝ` of a plane wave. -/ @@ -108,9 +107,8 @@ lemma magneticFieldMatrix_eq_magneticFunction {d : ℕ} {𝓕 : FreeSpace} {A : ElectromagneticPotential d} {s : Direction d} (P : IsPlaneWave 𝓕 A s) (t : Time) (x : Space d) : A.magneticFieldMatrix 𝓕.c t x = - P.magneticFunction (⟪x, s.unit⟫_ℝ - 𝓕.c * t) := by - rw [Classical.choose_spec P.2 t x] - rfl + P.magneticFunction (⟪x, s.unit⟫_ℝ - 𝓕.c * t) := + Classical.choose_spec P.2 t x /-! @@ -124,9 +122,8 @@ lemma electricFunction_eq_electricField {d : ℕ} P.electricFunction = fun u => A.electricField 𝓕.c ⟨(- u)/𝓕.c.1⟩ (0 : Space d) := by funext u - rw [P.electricField_eq_electricFunction] - congr - simp only [inner_zero_left, zero_sub] + rw [P.electricField_eq_electricFunction, inner_zero_left, zero_sub] + congr 1 field_simp lemma magneticFunction_eq_magneticFieldMatrix {d : ℕ} @@ -135,9 +132,8 @@ lemma magneticFunction_eq_magneticFieldMatrix {d : ℕ} P.magneticFunction = fun u => A.magneticFieldMatrix 𝓕.c ⟨(- u)/𝓕.c.1⟩ (0 : Space d) := by funext u - rw [P.magneticFieldMatrix_eq_magneticFunction] - congr - simp only [inner_zero_left, zero_sub] + rw [P.magneticFieldMatrix_eq_magneticFunction, inner_zero_left, zero_sub] + congr 1 field_simp /-! @@ -153,10 +149,8 @@ lemma electricFunction_unique {d : ℕ} {𝓕 : FreeSpace} E1 = P.electricFunction := by funext x obtain ⟨t, rfl⟩ : ∃ t, x = ⟪0, s.unit⟫_ℝ - 𝓕.c * t := by use (- x/𝓕.c); field_simp; simp - trans A.electricField 𝓕.c t (0 : Space d) - · rw [hE₁] - rfl - · rw [P.electricField_eq_electricFunction] + rw [← P.electricField_eq_electricFunction, hE₁] + rfl /-! @@ -173,9 +167,7 @@ lemma magneticFunction_unique {d : ℕ} {𝓕 : FreeSpace} B1 = P.magneticFunction := by funext x obtain ⟨t, rfl⟩ : ∃ t, x = ⟪0, s.unit⟫_ℝ - 𝓕.c * t := by use (- x/𝓕.c); field_simp; simp - trans A.magneticFieldMatrix 𝓕.c t (0 : Space d) - · rw [hB₁] - · rw [P.magneticFieldMatrix_eq_magneticFunction] + rw [← P.magneticFieldMatrix_eq_magneticFunction, hB₁] /-! @@ -192,9 +184,7 @@ lemma electricFunction_differentiable {d : ℕ} apply (electricField_differentiable hA).comp refine Differentiable.prodMk ?_ ?_ · change Differentiable ℝ (Time.toRealCLE.symm ∘ fun u => -u / 𝓕.c.val) - apply Differentiable.comp - · fun_prop - · fun_prop + fun_prop · fun_prop lemma magneticFunction_differentiable {d : ℕ} @@ -209,9 +199,7 @@ lemma magneticFunction_differentiable {d : ℕ} apply (magneticFieldMatrix_differentiable A hA ij).comp refine Differentiable.prodMk ?_ ?_ · change Differentiable ℝ (Time.toRealCLE.symm ∘ fun u => -u / 𝓕.c.val) - apply Differentiable.comp - · fun_prop - · fun_prop + fun_prop · fun_prop /-! @@ -226,23 +214,10 @@ lemma electricField_time_deriv {d : ℕ} (x : Space d) : ∂ₜ (A.electricField 𝓕.c · x) t = - 𝓕.c.val • fderiv ℝ P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) 1 := by - conv_lhs => - enter [1, t] - rw [P.electricField_eq_electricFunction] - rw [Time.deriv_eq] - rw [fderiv_fun_comp] - simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_eq_smul_deriv, one_smul, - neg_smul] - rw [fderiv_fun_sub] - simp only [fderiv_fun_const, Pi.zero_apply, zero_sub, _root_.neg_apply, neg_smul, - neg_inj] - rw [fderiv_const_mul] - simp only [FunLike.coe_smul, Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one] - · fun_prop - · fun_prop - · fun_prop - · exact (P.electricFunction_differentiable hA).differentiableAt - · fun_prop + have h : A.electricField 𝓕.c = planeWave P.electricFunction 𝓕.c.val s := + Classical.choose_spec P.1 + rw [h, planeWave_time_deriv (P.electricFunction_differentiable hA)] + simp [planeWave_eq] lemma magneticFieldMatrix_time_deriv {d : ℕ} {𝓕 : FreeSpace} {A : ElectromagneticPotential d} @@ -256,20 +231,9 @@ lemma magneticFieldMatrix_time_deriv {d : ℕ} rw [Time.deriv_eq] change fderiv ℝ ((fun u => P.magneticFunction u (i, j)) ∘ fun t => ⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) t 1 = _ - rw [fderiv_comp] - simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_eq_smul_deriv, smul_eq_mul, - one_mul, neg_mul] - rw [fderiv_fun_sub] - simp only [fderiv_fun_const, Pi.zero_apply, zero_sub, _root_.neg_apply, neg_mul, - neg_inj, mul_eq_mul_right_iff] - rw [fderiv_const_mul] - simp only [FunLike.coe_smul, Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one, - true_or] - · fun_prop - · fun_prop - · fun_prop - · exact (magneticFunction_differentiable P hA (i, j)).differentiableAt - · fun_prop + rw [fderiv_comp _ (magneticFunction_differentiable P hA (i, j)).differentiableAt (by fun_prop), + fderiv_fun_sub (by fun_prop) (by fun_prop), fderiv_const_mul (by fun_prop)] + simp [Time.fderiv_val] /-! @@ -283,20 +247,11 @@ lemma electricField_space_deriv {d : ℕ} (x : Space d) (i : Fin d) : ∂[i] (A.electricField 𝓕.c t ·) x = s.unit i • fderiv ℝ P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) 1 := by - conv_lhs => - enter [2, t] - rw [P.electricField_eq_electricFunction] - rw [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_comp] - simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_eq_smul_deriv, one_smul] - rw [fderiv_fun_sub] - simp only [fderiv_fun_const, Pi.zero_apply, sub_zero] - rw [← Space.deriv_eq_fderiv_basis] - simp only [deriv_inner_left] - · fun_prop - · fun_prop - · exact (P.electricFunction_differentiable hA).differentiableAt - · fun_prop + have h : A.electricField 𝓕.c = planeWave P.electricFunction 𝓕.c.val s := + Classical.choose_spec P.1 + rw [h] + simp only [planeWave_space_deriv (P.electricFunction_differentiable hA)] + simp [planeWave_eq] lemma magneticFieldMatrix_space_deriv {d : ℕ} {𝓕 : FreeSpace} {A : ElectromagneticPotential d} @@ -311,17 +266,12 @@ lemma magneticFieldMatrix_space_deriv {d : ℕ} rw [Space.deriv_eq_fderiv_basis] change fderiv ℝ ((fun u => P.magneticFunction u (i, j)) ∘ fun x => ⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) x _ = _ - rw [fderiv_comp] + rw [fderiv_comp _ (magneticFunction_differentiable P hA (i, j)).differentiableAt (by fun_prop), + fderiv_fun_sub (by fun_prop) (by fun_prop)] simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_eq_smul_deriv, smul_eq_mul, - one_mul, mul_eq_mul_right_iff] - rw [fderiv_fun_sub] - simp only [fderiv_fun_const, Pi.zero_apply, sub_zero] + one_mul, mul_eq_mul_right_iff, fderiv_fun_const, Pi.zero_apply, sub_zero] rw [← Space.deriv_eq_fderiv_basis] simp only [deriv_inner_left, true_or] - · fun_prop - · fun_prop - · exact (magneticFunction_differentiable P hA (i, j)).differentiableAt - · fun_prop /-! @@ -334,10 +284,8 @@ lemma electricField_space_deriv_eq_time_deriv {d : ℕ} {𝓕 : FreeSpace} (x : Space d) (i : Fin d) (k : Fin d) : ∂[k] (A.electricField 𝓕.c t · i) x = - (s.unit k / 𝓕.c.val) • ∂ₜ (A.electricField 𝓕.c · x i) t := by - rw [Space.deriv_euclid] - rw [IsPlaneWave.electricField_space_deriv P hA t x k] - rw [Time.deriv_euclid] - rw [IsPlaneWave.electricField_time_deriv P hA t x] + rw [Space.deriv_euclid, IsPlaneWave.electricField_space_deriv P hA t x k, Time.deriv_euclid, + IsPlaneWave.electricField_time_deriv P hA t x] simp only [fderiv_eq_smul_deriv, one_smul, PiLp.smul_apply, smul_eq_mul, neg_mul, mul_neg, neg_neg] field_simp @@ -375,29 +323,16 @@ lemma time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator {d : ℕ} ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j)) t = ∂ₜ (fun t => s.unit j / 𝓕.c * A.electricField 𝓕.c t x i - s.unit i / 𝓕.c * A.electricField 𝓕.c t x j) t := by - rw [time_deriv_magneticFieldMatrix] - rw [P.electricField_space_deriv_eq_time_deriv, P.electricField_space_deriv_eq_time_deriv] + have he : ∀ k, DifferentiableAt ℝ (fun t => A.electricField 𝓕.c t x k) t := + fun k => (electricField_apply_differentiable_time hA x k).differentiableAt + rw [time_deriv_magneticFieldMatrix A hA, P.electricField_space_deriv_eq_time_deriv hA, + P.electricField_space_deriv_eq_time_deriv hA] conv_rhs => - rw [Time.deriv_eq] - rw [fderiv_fun_sub (by - apply Differentiable.differentiableAt - apply Differentiable.const_mul - exact electricField_apply_differentiable_time hA _ _) (by - apply Differentiable.differentiableAt - apply Differentiable.const_mul - exact electricField_apply_differentiable_time hA _ _)] - rw [fderiv_const_mul (by - apply Differentiable.differentiableAt - exact electricField_apply_differentiable_time hA _ _)] - rw [fderiv_const_mul (by - apply Differentiable.differentiableAt - exact electricField_apply_differentiable_time hA _ _)] + rw [Time.deriv_eq, fderiv_fun_sub ((he i).const_mul _) ((he j).const_mul _), + fderiv_const_mul (he i), fderiv_const_mul (he j)] simp [← Time.deriv_eq] field_simp ring - · exact hA - · exact hA - · exact hA /-! @@ -412,21 +347,16 @@ lemma space_deriv_magneticFieldMatrix_eq_electricField_mul_propogator {d : ℕ} ∂[k] (A.magneticFieldMatrix 𝓕.c t · (i, j)) x = ∂[k] (fun x => s.unit j / 𝓕.c * A.electricField 𝓕.c t x i - s.unit i / 𝓕.c * A.electricField 𝓕.c t x j) x := by - rw [P.magneticFieldMatrix_space_deriv_eq_time_deriv hA] - rw [P.time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator hA] - rw [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sub] - rw [fderiv_const_mul, fderiv_const_mul] + rw [P.magneticFieldMatrix_space_deriv_eq_time_deriv hA, + P.time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator hA, + Space.deriv_eq_fderiv_basis, fderiv_fun_sub, fderiv_const_mul, fderiv_const_mul] simp [← Space.deriv_eq_fderiv_basis] - rw [Time.deriv_eq] - rw [fderiv_fun_sub] - rw [fderiv_const_mul, fderiv_const_mul] + rw [Time.deriv_eq, fderiv_fun_sub, fderiv_const_mul, fderiv_const_mul] simp [← Time.deriv_eq] - rw [P.electricField_space_deriv_eq_time_deriv, P.electricField_space_deriv_eq_time_deriv] + rw [P.electricField_space_deriv_eq_time_deriv hA, P.electricField_space_deriv_eq_time_deriv hA] simp only [smul_eq_mul, neg_mul, mul_neg, sub_neg_eq_add] field_simp ring - any_goals exact hA any_goals apply Differentiable.differentiableAt any_goals apply Differentiable.const_mul any_goals exact electricField_apply_differentiable_time hA x _ @@ -446,12 +376,8 @@ lemma magneticFieldMatrix_eq_propogator_cross_electricField {d : ℕ} s.unit i * A.electricField 𝓕.c t x j) + C := by apply Space.equal_up_to_const_of_deriv_eq · exact magneticFieldMatrix_differentiable A hA (i, j) - · apply Differentiable.const_mul - apply Differentiable.sub - · apply Differentiable.const_mul - exact electricField_apply_differentiable hA - · apply Differentiable.const_mul - exact electricField_apply_differentiable hA + · exact (((electricField_apply_differentiable hA).const_mul _).sub + ((electricField_apply_differentiable hA).const_mul _)).const_mul _ · intro t x rw [P.time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator hA t x i j] congr @@ -483,8 +409,7 @@ lemma time_deriv_electricField_eq_magneticFieldMatrix {d : ℕ} ∂ₜ (fun t => 𝓕.c * ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j) t := by have hBd : ∀ k, Differentiable ℝ (fun t => A.magneticFieldMatrix 𝓕.c t x (i, k)) := fun k => magneticFieldMatrix_differentiable_time A (hA.of_le ENat.LEInfty.out) x (i, k) - rw [Time.deriv_euclid] - rw [time_deriv_electricField_of_isExtrema hA 0 _ h t x i] + rw [Time.deriv_euclid, time_deriv_electricField_of_isExtrema hA 0 _ h t x i] simp only [one_div, _root_.mul_inv_rev, LorentzCurrentDensity.currentDensity_zero, Pi.zero_apply, PiLp.zero_apply, mul_zero, sub_zero] conv_lhs => @@ -494,8 +419,7 @@ lemma time_deriv_electricField_eq_magneticFieldMatrix {d : ℕ} simp [← Time.deriv_eq] have h1 : ∂ₜ (fun t => ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j) t = ∑ j, ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j)) t * s.unit j := by - rw [Time.deriv_eq] - rw [fderiv_fun_sum] + rw [Time.deriv_eq, fderiv_fun_sum] simp only [FunLike.coe_sum, Finset.sum_apply] conv_lhs => enter [2, k] @@ -543,21 +467,17 @@ lemma space_deriv_electricField_eq_magneticFieldMatrix {d : ℕ} ∂[k] (A.electricField 𝓕.c t · i) x = ∂[k] (fun x => 𝓕.c * ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j) x := by have hA2 : ContDiff ℝ 2 A := hA.of_le ENat.LEInfty.out - rw [P.electricField_space_deriv_eq_time_deriv hA2 t x i k] - rw [P.time_deriv_electricField_eq_magneticFieldMatrix hA h t x i] - rw [Time.deriv_eq] - rw [fderiv_const_mul] - rw [fderiv_fun_sum] + rw [P.electricField_space_deriv_eq_time_deriv hA2 t x i k, + P.time_deriv_electricField_eq_magneticFieldMatrix hA h t x i, Time.deriv_eq, fderiv_const_mul, + fderiv_fun_sum] simp [Finset.mul_sum, - Finset.sum_neg_distrib] - rw [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sum] + rw [Space.deriv_eq_fderiv_basis, fderiv_fun_sum] simp [- Finset.sum_neg_distrib] congr funext j rw [fderiv_mul_const, fderiv_const_mul, fderiv_mul_const] simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [← Space.deriv_eq_fderiv_basis] - rw [P.magneticFieldMatrix_space_deriv_eq_time_deriv hA2 t x i j k] + rw [← Space.deriv_eq_fderiv_basis, P.magneticFieldMatrix_space_deriv_eq_time_deriv hA2 t x i j k] simp [← Time.deriv_eq] field_simp any_goals apply Differentiable.differentiableAt @@ -594,11 +514,8 @@ lemma electricField_eq_propogator_cross_magneticFieldMatrix {d : ℕ} have hA2 : ContDiff ℝ 2 A := hA.of_le ENat.LEInfty.out apply Space.equal_up_to_const_of_deriv_eq · exact electricField_apply_differentiable hA2 - · apply Differentiable.const_mul - apply Differentiable.fun_sum - intro j _ - apply Differentiable.mul_const - exact magneticFieldMatrix_differentiable A hA2 (i, j) + · exact (Differentiable.fun_sum fun j _ => + (magneticFieldMatrix_differentiable A hA2 (i, j)).mul_const _).const_mul _ · intro t x rw [P.time_deriv_electricField_eq_magneticFieldMatrix hA _ t x i] congr diff --git a/Physlib/FluidDynamics/NavierStokes/Basic.lean b/Physlib/FluidDynamics/NavierStokes/Basic.lean index 89fa5e940..c402c44dd 100644 --- a/Physlib/FluidDynamics/NavierStokes/Basic.lean +++ b/Physlib/FluidDynamics/NavierStokes/Basic.lean @@ -64,15 +64,9 @@ theorem navierStokes_iff_convectiveNavierStokes (hMomentumDensity : ∀ t, Differentiable ℝ (FluidDynamics.NavierStokes.momentumDensity d data.toFluidState t)) (hVelocitySpace : ∀ t, Differentiable ℝ (data.velocity t)) : - NavierStokes d data ↔ ConvectiveNavierStokes d data := by - constructor - · intro hConservative - refine ⟨hConservative.1, ?_⟩ - exact (FluidDynamics.NavierStokes.momentumEquation_iff_convectiveMomentumEquation d data - hConservative.1 hRhoTime hVelocityTime hMomentumDensity hVelocitySpace).mp hConservative.2 - · intro hConvective - refine ⟨hConvective.1, ?_⟩ - exact (FluidDynamics.NavierStokes.momentumEquation_iff_convectiveMomentumEquation d data - hConvective.1 hRhoTime hVelocityTime hMomentumDensity hVelocitySpace).mpr hConvective.2 + NavierStokes d data ↔ ConvectiveNavierStokes d data := + and_congr_right fun h => + FluidDynamics.NavierStokes.momentumEquation_iff_convectiveMomentumEquation d data h + hRhoTime hVelocityTime hMomentumDensity hVelocitySpace end FluidDynamics diff --git a/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean b/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean index 62e780ebe..9117f7f2e 100644 --- a/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean +++ b/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean @@ -194,7 +194,7 @@ expand the outer operator of a composition without touching the inner one. -/ lemma dWirtingerDir_apply (g : V → ℂ) (v u : V) : dWirtingerDir g v u = (1 / 2 : ℂ) * (fderiv ℝ g u v - Complex.I * fderiv ℝ g u (Complex.I • v)) := by - simp only [dWirtingerDir, weightedDirDeriv]; ring + simp only [dWirtingerDir, weightedDirDeriv, neg_mul, ← sub_eq_add_neg] /-- Definitional unfolding of `dWirtingerAntiDir` to the explicit Wirtinger combination. -/ lemma dWirtingerAntiDir_apply (g : V → ℂ) (v u : V) : @@ -215,50 +215,47 @@ rule. /-- Constants have zero holomorphic directional Wirtinger derivative, `∂_v c = 0`. -/ @[simp] lemma dWirtingerDir_const (c : ℂ) (v u : V) : - dWirtingerDir (fun _ : V => c) v u = 0 := by - simp [dWirtingerDir_apply, fderiv_const_apply] + dWirtingerDir (fun _ : V => c) v u = 0 := by simp [dWirtingerDir_apply] /-- Constants have zero anti-holomorphic directional Wirtinger derivative, `∂̄_v c = 0`. -/ @[simp] lemma dWirtingerAntiDir_const (c : ℂ) (v u : V) : dWirtingerAntiDir (fun _ : V => c) v u = 0 := by - simp [dWirtingerAntiDir_apply, fderiv_const_apply] + simp [dWirtingerAntiDir_apply] /-- `dWirtingerDir` of a negated function, `∂_v(−g) = −∂_v g`. Holds with no differentiability hypothesis, since `fderiv` of a negation is unconditional. -/ @[simp] lemma dWirtingerDir_neg (g : V → ℂ) (v u : V) : dWirtingerDir (fun p => -(g p)) v u = -(dWirtingerDir g v u) := by - simp only [dWirtingerDir_apply, fderiv_fun_neg, _root_.neg_apply]; ring + simp [dWirtingerDir_apply, fderiv_fun_neg, mul_sub, neg_add_eq_sub] /-- `dWirtingerAntiDir` of a negated function, `∂̄_v(−g) = −∂̄_v g`. -/ @[simp] lemma dWirtingerAntiDir_neg (g : V → ℂ) (v u : V) : dWirtingerAntiDir (fun p => -(g p)) v u = -(dWirtingerAntiDir g v u) := by - simp only [dWirtingerAntiDir_apply, fderiv_fun_neg, _root_.neg_apply]; ring + simp [dWirtingerAntiDir_apply, fderiv_fun_neg, mul_add, add_comm] /-- Additivity of `dWirtingerDir`, `∂_v(g + h) = ∂_v g + ∂_v h`. -/ lemma dWirtingerDir_add {g h : V → ℂ} (hg : DifferentiableAt ℝ g u) (hh : DifferentiableAt ℝ h u) (v : V) : dWirtingerDir (g + h) v u = dWirtingerDir g v u + dWirtingerDir h v u := by - simp only [dWirtingerDir_apply, fderiv_add hg hh, add_apply]; ring + simp [dWirtingerDir_apply, fderiv_add hg hh, mul_sub, mul_add, add_sub_add_comm] /-- Additivity of `dWirtingerAntiDir`, `∂̄_v(g + h) = ∂̄_v g + ∂̄_v h`. -/ lemma dWirtingerAntiDir_add {g h : V → ℂ} (hg : DifferentiableAt ℝ g u) (hh : DifferentiableAt ℝ h u) (v : V) : dWirtingerAntiDir (g + h) v u = dWirtingerAntiDir g v u + dWirtingerAntiDir h v u := by - simp only [dWirtingerAntiDir_apply, fderiv_add hg hh, add_apply]; ring + simp [dWirtingerAntiDir_apply, fderiv_add hg hh, mul_add, add_add_add_comm] /-- Compatibility of `dWirtingerDir` with complex scalar multiplication, `∂_v(c·g) = c·∂_v g`. -/ lemma dWirtingerDir_smul (c : ℂ) {g : V → ℂ} (hg : DifferentiableAt ℝ g u) (v : V) : dWirtingerDir (c • g) v u = c • dWirtingerDir g v u := by - simp only [dWirtingerDir_apply, fderiv_const_smul hg c, _root_.smul_apply, - smul_eq_mul]; ring + simp [dWirtingerDir_apply, fderiv_const_smul hg c, mul_sub, mul_left_comm] /-- Compatibility of `dWirtingerAntiDir` with complex scalar multiplication, `∂̄_v(c·g) = c·∂̄_v g`. -/ lemma dWirtingerAntiDir_smul (c : ℂ) {g : V → ℂ} (hg : DifferentiableAt ℝ g u) (v : V) : dWirtingerAntiDir (c • g) v u = c • dWirtingerAntiDir g v u := by - simp only [dWirtingerAntiDir_apply, fderiv_const_smul hg c, _root_.smul_apply, - smul_eq_mul]; ring + simp [dWirtingerAntiDir_apply, fderiv_const_smul hg c, mul_add, mul_left_comm] omit [NormedSpace ℂ V] in /-- The real Fréchet derivative of a product, evaluated at a tangent `v`. -/ @@ -286,15 +283,15 @@ lemma dWirtingerAntiDir_mul {g h : V → ℂ} (hg : DifferentiableAt ℝ g u) lemma dWirtingerDir_fun_sum {α : Type*} {s : Finset α} {F : α → V → ℂ} (hF : ∀ a ∈ s, DifferentiableAt ℝ (F a) u) (v : V) : dWirtingerDir (fun p => ∑ a ∈ s, F a p) v u = ∑ a ∈ s, dWirtingerDir (F a) v u := by - simp only [dWirtingerDir_apply, fderiv_fun_sum hF, sum_apply] - rw [Finset.mul_sum, ← Finset.sum_sub_distrib, Finset.mul_sum] + simp only [dWirtingerDir_apply, fderiv_fun_sum hF, sum_apply, mul_sub, Finset.mul_sum, + Finset.sum_sub_distrib] /-- Finite-sum rule for `dWirtingerAntiDir`, `∂̄_v(∑ₐ Fₐ) = ∑ₐ ∂̄_v Fₐ`. -/ lemma dWirtingerAntiDir_fun_sum {α : Type*} {s : Finset α} {F : α → V → ℂ} (hF : ∀ a ∈ s, DifferentiableAt ℝ (F a) u) (v : V) : dWirtingerAntiDir (fun p => ∑ a ∈ s, F a p) v u = ∑ a ∈ s, dWirtingerAntiDir (F a) v u := by - simp only [dWirtingerAntiDir_apply, fderiv_fun_sum hF, sum_apply] - rw [Finset.mul_sum, ← Finset.sum_add_distrib, Finset.mul_sum] + simp only [dWirtingerAntiDir_apply, fderiv_fun_sum hF, sum_apply, mul_add, Finset.mul_sum, + Finset.sum_add_distrib] /-! @@ -332,32 +329,26 @@ coefficients and swaps the holomorphic and anti-holomorphic parts. -/ lemma fderiv_star_eq {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] {f : E → ℂ} {u : E} (hf : DifferentiableAt ℝ f u) : fderiv ℝ (fun p : E => star (f p)) u = - Complex.conjCLE.toContinuousLinearMap.comp (fderiv ℝ f u) := by - rw [show (fun p : E => star (f p)) = Complex.conjCLE.toContinuousLinearMap ∘ f from rfl, - fderiv_comp u Complex.conjCLE.toContinuousLinearMap.differentiableAt hf, - ContinuousLinearMap.fderiv] + Complex.conjCLE.toContinuousLinearMap.comp (fderiv ℝ f u) := + (Complex.conjCLE.toContinuousLinearMap.hasFDerivAt.comp u hf.hasFDerivAt).fderiv /-- Conjugating the function swaps the operators up to an outer conjugation: `∂_v f̄ = conj (∂̄_v f)`. -/ lemma dWirtingerDir_star_comp (hf : DifferentiableAt ℝ f u) (v : V) : dWirtingerDir (fun p => star (f p)) v u = star (dWirtingerAntiDir f v u) := by - simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply] - rw [fderiv_star_eq hf] - simp only [ContinuousLinearMap.comp_apply, ContinuousLinearEquiv.coe_coe, - Complex.conjCLE_apply, Complex.star_def, map_mul, map_add, map_div₀, map_one, - map_ofNat, Complex.conj_I] + rw [dWirtingerDir_apply, dWirtingerAntiDir_apply, fderiv_star_eq hf] + simp only [one_div, ContinuousLinearMap.comp_apply, ContinuousLinearEquiv.coe_coe, + ContinuousAlgEquiv.coeCLE_apply, Complex.conjCAE_apply, star_mul', star_inv₀, + star_ofNat, star_add, RCLike.star_def, Complex.conj_I, neg_mul, + mul_eq_mul_left_iff, inv_eq_zero, OfNat.ofNat_ne_zero, or_false] ring /-- Conjugating the function swaps the operators up to an outer conjugation: `∂̄_v f̄ = conj (∂_v f)`. Dual of `dWirtingerDir_star_comp`. -/ lemma dWirtingerAntiDir_star_comp (hf : DifferentiableAt ℝ f u) (v : V) : dWirtingerAntiDir (fun p => star (f p)) v u = star (dWirtingerDir f v u) := by - simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply] - rw [fderiv_star_eq hf] - simp only [ContinuousLinearMap.comp_apply, ContinuousLinearEquiv.coe_coe, - Complex.conjCLE_apply, Complex.star_def, map_mul, map_sub, map_div₀, map_one, - map_ofNat, Complex.conj_I] - ring + rw [dWirtingerAntiDir_apply, dWirtingerDir_apply, fderiv_star_eq hf] + simp /-! @@ -392,18 +383,10 @@ lemma realLinear_apply_eq_wirtinger (L : ℂ →L[ℝ] ℂ) (w : ℂ) : L w = ((1 / 2 : ℂ) * (L 1 - Complex.I * L Complex.I)) * w + ((1 / 2 : ℂ) * (L 1 + Complex.I * L Complex.I)) * star w := by - calc - L w = L ((w.re : ℝ) • (1 : ℂ) + (w.im : ℝ) • Complex.I) := by - congr 1; apply Complex.ext <;> simp - _ = (w.re : ℝ) • L 1 + (w.im : ℝ) • L Complex.I := by - rw [map_add, map_smul, map_smul] - _ = ((1 / 2 : ℂ) * (L 1 - Complex.I * L Complex.I)) * w - + ((1 / 2 : ℂ) * (L 1 + Complex.I * L Complex.I)) * star w := by - apply Complex.ext <;> - simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, - Complex.mul_re, Complex.mul_im, Complex.conj_re, Complex.conj_im, - Complex.I_re, Complex.I_im] <;> - ring + have hw : w = (w.re : ℝ) • (1 : ℂ) + (w.im : ℝ) • Complex.I := by + apply Complex.ext <;> simp + nth_rewrite 1 [hw, map_add, map_smul, map_smul] + apply Complex.ext <;> simp <;> ring /-- The two-term Wirtinger chain rule for `dWirtingerDir`, outer `g : ℂ → ℂ` and inner `f : V → ℂ`: @@ -418,13 +401,10 @@ lemma dWirtingerDir_comp {g : ℂ → ℂ} (hg : DifferentiableAt ℝ g (f u)) dWirtingerDir (fun p => g (f p)) v u = dWirtingerDir g 1 (f u) * dWirtingerDir f v u + dWirtingerAntiDir g 1 (f u) * dWirtingerDir (fun p => star (f p)) v u := by - simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply, smul_eq_mul, mul_one] + simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply] rw [show (fun p => g (f p)) = g ∘ f from rfl, fderiv_comp u hg hf, fderiv_star_eq hf] - simp only [ContinuousLinearMap.comp_apply] - have hA := realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u v) - have hB := realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u (Complex.I • v)) - rw [hA, hB] - simp only [ContinuousLinearEquiv.coe_coe, Complex.conjCLE_apply, Complex.star_def] + simp [realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u v), + realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u (Complex.I • v))] ring /-- The two-term Wirtinger chain rule for `dWirtingerAntiDir`, the anti-holomorphic dual of @@ -439,13 +419,10 @@ lemma dWirtingerAntiDir_comp {g : ℂ → ℂ} (hg : DifferentiableAt ℝ g (f u dWirtingerAntiDir (fun p => g (f p)) v u = dWirtingerDir g 1 (f u) * dWirtingerAntiDir f v u + dWirtingerAntiDir g 1 (f u) * dWirtingerAntiDir (fun p => star (f p)) v u := by - simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply, smul_eq_mul, mul_one] + simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply] rw [show (fun p => g (f p)) = g ∘ f from rfl, fderiv_comp u hg hf, fderiv_star_eq hf] - simp only [ContinuousLinearMap.comp_apply] - have hA := realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u v) - have hB := realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u (Complex.I • v)) - rw [hA, hB] - simp only [ContinuousLinearEquiv.coe_coe, Complex.conjCLE_apply, Complex.star_def] + simp [realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u v), + realLinear_apply_eq_wirtinger (fderiv ℝ g (f u)) (fderiv ℝ f u (Complex.I • v))] ring /-! @@ -498,10 +475,8 @@ map is the map itself, the real Fréchet derivative of `g ∘ L` at `u`, applied the derivative of `g` at `L u` applied to `L x`. -/ private lemma fderiv_comp_clm_apply {g : V' → ℂ} {L : V →L[ℝ] V'} {u : V} (hg : DifferentiableAt ℝ g (L u)) (x : V) : - fderiv ℝ (fun p => g (L p)) u x = fderiv ℝ g (L u) (L x) := by - rw [show (fun p => g (L p)) = g ∘ (L : V → V') from rfl, - fderiv_comp u hg L.differentiableAt, ContinuousLinearMap.fderiv, - ContinuousLinearMap.comp_apply] + fderiv ℝ (fun p => g (L p)) u x = fderiv ℝ g (L u) (L x) := + DFunLike.congr_fun (hg.hasFDerivAt.comp u L.hasFDerivAt).fderiv x /-- Domain conjugation swaps the operators: precomposing with a conjugate-`ℂ`-linear `L` turns the holomorphic derivative of `g ∘ L` at `u` into the anti-holomorphic derivative of @@ -511,9 +486,7 @@ lemma dWirtingerDir_comp_conjLinear {g : V' → ℂ} {L : V →L[ℝ] V'} {u : V (hL : ∀ x : V, L (Complex.I • x) = -(Complex.I • L x)) (hg : DifferentiableAt ℝ g (L u)) (v : V) : dWirtingerDir (fun p => g (L p)) v u = dWirtingerAntiDir g (L v) (L u) := by - simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply, fderiv_comp_clm_apply hg, hL, - map_neg] - ring + simp [dWirtingerDir_apply, dWirtingerAntiDir_apply, fderiv_comp_clm_apply hg, hL] /-- Dual of `dWirtingerDir_comp_conjLinear`: the anti-holomorphic derivative of `g ∘ L` at `u` is the holomorphic derivative of `g` at the mapped point `L u`, in the mapped direction @@ -522,9 +495,8 @@ lemma dWirtingerAntiDir_comp_conjLinear {g : V' → ℂ} {L : V →L[ℝ] V'} {u (hL : ∀ x : V, L (Complex.I • x) = -(Complex.I • L x)) (hg : DifferentiableAt ℝ g (L u)) (v : V) : dWirtingerAntiDir (fun p => g (L p)) v u = dWirtingerDir g (L v) (L u) := by - simp only [dWirtingerDir_apply, dWirtingerAntiDir_apply, fderiv_comp_clm_apply hg, hL, - map_neg] - ring + simp [dWirtingerDir_apply, dWirtingerAntiDir_apply, fderiv_comp_clm_apply hg, hL, + ← sub_eq_add_neg] end DomainConjugation @@ -558,29 +530,32 @@ holomorphic derivative is the full real derivative, `∂_v f = d_v f`. -/ lemma dWirtingerDir_eq_of_clinear {v : V} (h : fderiv ℝ f u (Complex.I • v) = Complex.I • fderiv ℝ f u v) : dWirtingerDir f v u = fderiv ℝ f u v := by - simp only [dWirtingerDir_apply, h, smul_eq_mul]; rw [← mul_assoc, Complex.I_mul_I]; ring + simp only [dWirtingerDir_apply, h, smul_eq_mul] + linear_combination -fderiv ℝ f u v / 2 * Complex.I_sq /-- Holomorphic collapse: the anti-holomorphic derivative vanishes along a direction of `ℂ`-linearity, `∂̄_v f = 0`. -/ lemma dWirtingerAntiDir_eq_zero_of_clinear {v : V} (h : fderiv ℝ f u (Complex.I • v) = Complex.I • fderiv ℝ f u v) : dWirtingerAntiDir f v u = 0 := by - simp only [dWirtingerAntiDir_apply, h, smul_eq_mul]; rw [← mul_assoc, Complex.I_mul_I]; ring + simp only [dWirtingerAntiDir_apply, h, smul_eq_mul] + linear_combination fderiv ℝ f u v / 2 * Complex.I_sq /-- Anti-holomorphic collapse: a direction of conjugate-`ℂ`-linearity kills the holomorphic derivative, `∂_v f = 0`. -/ lemma dWirtingerDir_eq_zero_of_antilinear {v : V} (h : fderiv ℝ f u (Complex.I • v) = -(Complex.I • fderiv ℝ f u v)) : dWirtingerDir f v u = 0 := by - simp only [dWirtingerDir_apply, h, smul_eq_mul, mul_neg]; rw [← mul_assoc, Complex.I_mul_I]; ring + simp only [dWirtingerDir_apply, h, smul_eq_mul] + linear_combination fderiv ℝ f u v / 2 * Complex.I_sq /-- Anti-holomorphic collapse: the anti-holomorphic derivative is the full real derivative along a direction of conjugate-`ℂ`-linearity, `∂̄_v f = d_v f`. -/ lemma dWirtingerAntiDir_eq_of_antilinear {v : V} (h : fderiv ℝ f u (Complex.I • v) = -(Complex.I • fderiv ℝ f u v)) : dWirtingerAntiDir f v u = fderiv ℝ f u v := by - simp only [dWirtingerAntiDir_apply, h, smul_eq_mul, mul_neg] - rw [← mul_assoc, Complex.I_mul_I]; ring + simp only [dWirtingerAntiDir_apply, h, smul_eq_mul] + linear_combination -fderiv ℝ f u v / 2 * Complex.I_sq /-! @@ -657,10 +632,7 @@ private lemma fderiv_weightedDirDeriv (hf' : DifferentiableAt ℝ (fderiv ℝ f) fderiv ℝ (weightedDirDeriv f c b₁ b₂) u a = (1 / 2 : ℂ) * (fderiv ℝ (fderiv ℝ f) u a b₁ + c * fderiv ℝ (fderiv ℝ f) u a b₂) := by - rw [(hasFDerivAt_weightedDirDeriv hf' c b₁ b₂).fderiv] - simp only [add_apply, _root_.smul_apply, - ContinuousLinearMap.coe_comp, Function.comp_apply, ContinuousLinearMap.apply_apply, - smul_eq_mul, mul_add] + simp [(hasFDerivAt_weightedDirDeriv hf' c b₁ b₂).fderiv, mul_add] /-- A directional derivative is a `weightedDirDeriv`: anti-holomorphic with `c = i`. -/ private lemma dWirtingerAntiDir_eq_weightedDirDeriv (w : V) : @@ -688,7 +660,7 @@ private lemma fderiv_dWirtingerDir (hf' : DifferentiableAt ℝ (fderiv ℝ f) u) fderiv ℝ (fun p => dWirtingerDir f v p) u a = (1 / 2 : ℂ) * (fderiv ℝ (fderiv ℝ f) u a v - Complex.I * fderiv ℝ (fderiv ℝ f) u a (Complex.I • v)) := by - rw [dWirtingerDir_eq_weightedDirDeriv, fderiv_weightedDirDeriv hf']; ring + rw [dWirtingerDir_eq_weightedDirDeriv, fderiv_weightedDirDeriv hf', neg_mul, ← sub_eq_add_neg] /-! @@ -722,19 +694,15 @@ has at each point of its domain. real-differentiable. -/ lemma differentiableAt_dWirtingerDir (hf2 : ContDiffAt ℝ 2 f u) (v : V) : DifferentiableAt ℝ (fun p => dWirtingerDir f v p) u := by - rw [dWirtingerDir_eq_weightedDirDeriv] - have hf' : DifferentiableAt ℝ (fderiv ℝ f) u := - (hf2.fderiv_right (m := 1) (by norm_num)).differentiableAt one_ne_zero - exact (hasFDerivAt_weightedDirDeriv hf' _ _ _).differentiableAt + exact (hasFDerivAt_weightedDirDeriv + ((hf2.fderiv_right (m := 1) le_rfl).differentiableAt one_ne_zero) _ _ _).differentiableAt /-- On a `C²` field the anti-holomorphic directional derivative is itself real-differentiable. -/ lemma differentiableAt_dWirtingerAntiDir (hf2 : ContDiffAt ℝ 2 f u) (w : V) : DifferentiableAt ℝ (fun p => dWirtingerAntiDir f w p) u := by - rw [dWirtingerAntiDir_eq_weightedDirDeriv] - have hf' : DifferentiableAt ℝ (fderiv ℝ f) u := - (hf2.fderiv_right (m := 1) (by norm_num)).differentiableAt one_ne_zero - exact (hasFDerivAt_weightedDirDeriv hf' _ _ _).differentiableAt + exact (hasFDerivAt_weightedDirDeriv + ((hf2.fderiv_right (m := 1) le_rfl).differentiableAt one_ne_zero) _ _ _).differentiableAt /-- The holomorphic directional derivative depends only on the field near the point: fields agreeing on a neighbourhood have equal derivative. -/ @@ -769,14 +737,10 @@ theorem dWirtingerDir_dWirtingerAntiDir_comm (hf2 : ContDiffAt ℝ 2 f u) (v w : dWirtingerDir (fun p => dWirtingerAntiDir f w p) v u = dWirtingerAntiDir (fun p => dWirtingerDir f v p) w u := by have hf' : DifferentiableAt ℝ (fderiv ℝ f) u := - (hf2.fderiv_right (m := 1) (by norm_num)).differentiableAt one_ne_zero + (hf2.fderiv_right (m := 1) le_rfl).differentiableAt one_ne_zero have hsymm : IsSymmSndFDerivAt ℝ f u := hf2.isSymmSndFDerivAt (by simp) - rw [dWirtingerDir_apply (fun p => dWirtingerAntiDir f w p) v u, - dWirtingerAntiDir_apply (fun p => dWirtingerDir f v p) w u, - fderiv_dWirtingerAntiDir hf', fderiv_dWirtingerAntiDir hf', - fderiv_dWirtingerDir hf', fderiv_dWirtingerDir hf', - hsymm.eq w v, hsymm.eq w (Complex.I • v), - hsymm.eq (Complex.I • w) v, hsymm.eq (Complex.I • w) (Complex.I • v)] + rw [dWirtingerDir_apply, dWirtingerAntiDir_apply] + simp only [fderiv_dWirtingerAntiDir hf', fderiv_dWirtingerDir hf', hsymm.eq] ring end Physlib.Wirtinger diff --git a/Physlib/Mathematics/Calculus/Wirtinger/Coordinate.lean b/Physlib/Mathematics/Calculus/Wirtinger/Coordinate.lean index 590d2864c..53f060eea 100644 --- a/Physlib/Mathematics/Calculus/Wirtinger/Coordinate.lean +++ b/Physlib/Mathematics/Calculus/Wirtinger/Coordinate.lean @@ -259,10 +259,7 @@ Kronecker coordinate-value lemmas `dWirtingerCoord_coordProj` / `dWirtingerAntiC which feed it the slot-I real and imaginary directions. -/ private lemma fderiv_coordProj (J : ι) (u d : (ι → ℂ)) : fderiv ℝ (fun v : (ι → ℂ) => v J) u d = d J := by - have h : HasFDerivAt (fun v : (ι → ℂ) => v J) - (ContinuousLinearMap.proj (R := ℝ) (φ := fun _ : ι => ℂ) J) u := - (ContinuousLinearMap.proj (R := ℝ) (φ := fun _ : ι => ℂ) J).hasFDerivAt - rw [h.fderiv, ContinuousLinearMap.proj_apply] + rw [(hasFDerivAt_apply (𝕜 := ℝ) J u).fderiv, ContinuousLinearMap.proj_apply] /-- `∂_I z^J = δ_IJ`. The holomorphic coordinate-independence value; also feeds the coordinate-difference rule `dWirtingerCoord_coordDiff` and the conjugate-coordinate value @@ -274,8 +271,7 @@ coordinate-difference rule `dWirtingerCoord_coordDiff` and the conjugate-coordin rw [dWirtingerCoord_apply I, fderiv_coordProj, fderiv_coordProj] by_cases h : I = J · subst h; rw [Pi.single_eq_same, Pi.single_eq_same, if_pos rfl, Complex.I_mul_I]; ring - · rw [Pi.single_eq_of_ne (Ne.symm h), Pi.single_eq_of_ne (Ne.symm h), if_neg h, - mul_zero, sub_zero, mul_zero] + · simp [h] /-- Pointwise additivity of the holomorphic coordinate derivative at `u`: `∂_I (f + g) = ∂_I f + ∂_I g`. Used to assemble the coordinate-difference rule @@ -348,14 +344,9 @@ holomorphic `f`. -/ lemma dWirtingerCoord_eq_zero_of_antiHolomorphic_apply {u : (ι → ℂ)} (hg : DifferentiableAt ℂ g (star u)) (I : ι) : dWirtingerCoord (fun v : (ι → ℂ) => g (star v)) I u = 0 := by - have hgr : DifferentiableAt ℝ g (conjCLM u) := by - rw [conjCLM_apply]; exact hg.restrictScalars ℝ - show dWirtingerDir (fun v : (ι → ℂ) => g (star v)) - (Pi.single I 1) u = 0 - rw [show (fun v : (ι → ℂ) => g (star v)) - = fun v => g (conjCLM v) from by funext v; rw [conjCLM_apply], - dWirtingerDir_comp_conjLinear conjCLM_smul_I hgr] - simp only [conjCLM_apply] + have hgr : DifferentiableAt ℝ g (conjCLM u) := hg.restrictScalars ℝ + change dWirtingerDir (fun v : (ι → ℂ) => g (conjCLM v)) (Pi.single I 1) u = 0 + rw [dWirtingerDir_comp_conjLinear conjCLM_smul_I hgr] exact dWirtingerAntiDir_eq_zero_of_clinear (clinear_of_holomorphic hg _) end @@ -405,12 +396,8 @@ value `dWirtingerCoord_conjCoord` (§C). -/ @[simp] lemma dWirtingerAntiCoord_coordProj (I J : ι) : dWirtingerAntiCoord (fun u : (ι → ℂ) => u J) I = 0 := by funext u - simp only [Pi.zero_apply] - rw [dWirtingerAntiCoord_apply I, fderiv_coordProj, fderiv_coordProj] - by_cases h : I = J - · subst h; rw [Pi.single_eq_same, Pi.single_eq_same, Complex.I_mul_I]; ring - · rw [Pi.single_eq_of_ne (Ne.symm h), Pi.single_eq_of_ne (Ne.symm h), - mul_zero, add_zero, mul_zero] + exact dWirtingerAntiDir_eq_zero_of_clinear (clinear_of_holomorphic + (ContinuousLinearMap.proj (R := ℂ) (φ := fun _ : ι => ℂ) J).differentiableAt _) /-- `∂_I z̄^J = 0`. The conjugate of `dWirtingerAntiCoord_coordProj` (`z̄^J = star z^J`), read off through `dWirtingerDir_star_comp` rather than recomputed. Used to assemble the @@ -418,13 +405,8 @@ coordinate-difference rule `dWirtingerCoord_coordDiff` (§C). -/ lemma dWirtingerCoord_conjCoord (I J : ι) : dWirtingerCoord (fun u : (ι → ℂ) => star (u J)) I = 0 := by funext u - have hd : DifferentiableAt ℝ (fun w : (ι → ℂ) => w J) u := - (ContinuousLinearMap.proj (R := ℝ) (φ := fun _ : ι => ℂ) J).differentiableAt - change dWirtingerDir (fun v => star ((fun w : (ι → ℂ) => w J) v)) - (Pi.single I 1) u = 0 - rw [dWirtingerDir_star_comp hd (Pi.single I 1)] - show star (dWirtingerAntiCoord (fun w : (ι → ℂ) => w J) I u) = 0 - rw [dWirtingerAntiCoord_coordProj, Pi.zero_apply, star_zero] + exact dWirtingerCoord_eq_zero_of_antiHolomorphic_apply (g := fun w => w J) + (ContinuousLinearMap.proj (R := ℂ) (φ := fun _ : ι => ℂ) J).differentiableAt I /-- `∂̄_I z̄^J = δ_IJ`. The conjugate of `dWirtingerCoord_coordProj`, read off through `dWirtingerAntiDir_star_comp` rather than recomputed. Used to assemble the @@ -435,11 +417,9 @@ lemma dWirtingerAntiCoord_conjCoord (I J : ι) : funext u have hd : DifferentiableAt ℝ (fun w : (ι → ℂ) => w J) u := (ContinuousLinearMap.proj (R := ℝ) (φ := fun _ : ι => ℂ) J).differentiableAt - change dWirtingerAntiDir (fun v => star ((fun w : (ι → ℂ) => w J) v)) - (Pi.single I 1) u = if I = J then 1 else 0 - rw [dWirtingerAntiDir_star_comp hd (Pi.single I 1)] - show star (dWirtingerCoord (fun w : (ι → ℂ) => w J) I u) = if I = J then 1 else 0 - rw [dWirtingerCoord_coordProj] + rw [show dWirtingerAntiCoord (fun u : (ι → ℂ) => star (u J)) I u + = star (dWirtingerCoord (fun w : (ι → ℂ) => w J) I u) + from dWirtingerAntiDir_star_comp hd (Pi.single I 1), dWirtingerCoord_coordProj] simp only [apply_ite (star : ℂ → ℂ), star_one, star_zero] /-- Pointwise additivity of the anti-holomorphic coordinate derivative at `u`: @@ -482,13 +462,10 @@ lemma dWirtingerAntiCoord_eq_complex_fderiv_apply {u : (ι → ℂ)} (hg : DifferentiableAt ℂ g (star u)) (I : ι) : dWirtingerAntiCoord (fun v : (ι → ℂ) => g (star v)) I u = fderiv ℂ g (star u) (Pi.single I 1) := by - have hgr : DifferentiableAt ℝ g (conjCLM u) := by - rw [conjCLM_apply]; exact hg.restrictScalars ℝ - show dWirtingerAntiDir (fun v : (ι → ℂ) => g (star v)) - (Pi.single I 1) u = fderiv ℂ g (star u) (Pi.single I 1) - rw [show (fun v : (ι → ℂ) => g (star v)) - = fun v => g (conjCLM v) from by funext v; rw [conjCLM_apply], - dWirtingerAntiDir_comp_conjLinear conjCLM_smul_I hgr] + have hgr : DifferentiableAt ℝ g (conjCLM u) := hg.restrictScalars ℝ + change dWirtingerAntiDir (fun v : (ι → ℂ) => g (conjCLM v)) (Pi.single I 1) u + = fderiv ℂ g (star u) (Pi.single I 1) + rw [dWirtingerAntiDir_comp_conjLinear conjCLM_smul_I hgr] simp only [conjCLM_apply, Pi.star_single, star_one] rw [dWirtingerDir_eq_of_clinear (clinear_of_holomorphic hg _), DifferentiableAt.fderiv_restrictScalars ℝ hg, ContinuousLinearMap.coe_restrictScalars'] @@ -496,9 +473,8 @@ lemma dWirtingerAntiCoord_eq_complex_fderiv_apply {u : (ι → ℂ)} /-- Holomorphic functions have zero anti-holomorphic coordinate derivative: `∂̄_I f = 0`. -/ lemma dWirtingerAntiCoord_eq_zero_of_holomorphic_apply {u : (ι → ℂ)} (hf : DifferentiableAt ℂ f u) (I : ι) : - dWirtingerAntiCoord f I u = 0 := by - show dWirtingerAntiDir f (Pi.single I 1) u = 0 - exact dWirtingerAntiDir_eq_zero_of_clinear (clinear_of_holomorphic hf _) + dWirtingerAntiCoord f I u = 0 := + dWirtingerAntiDir_eq_zero_of_clinear (clinear_of_holomorphic hf _) /-! @@ -516,8 +492,8 @@ and the negated conjugate coordinate — the form on which the `dWirtingerCoord` `dWirtingerAntiCoord` additivity rules apply. -/ private lemma coordDiff_eq_add_neg (J : ι) : (fun v : (ι → ℂ) => v J - star (v J)) - = (fun v => v J) + (fun v => -(star (v J))) := by - funext v; simp [sub_eq_add_neg] + = (fun v => v J) + (fun v => -(star (v J))) := + funext fun v => sub_eq_add_neg (v J) (star (v J)) /-- `∂_I (z^J − z̄^J) = δ_IJ`, from `∂_I z^J = δ_IJ` and `∂_I z̄^J = 0`. -/ @@ -594,7 +570,7 @@ lemma dWirtingerCoord_comp_holomorphic_apply {u : (ι → ℂ)} (hg : DifferentiableAt ℂ g (f u)) (hf : DifferentiableAt ℝ f u) (I : ι) : dWirtingerCoord (fun v => g (f v)) I u = deriv g (f u) * dWirtingerCoord f I u := by - rw [dWirtingerCoord_comp_apply (hg.hasFDerivAt.restrictScalars ℝ).differentiableAt hf I, + rw [dWirtingerCoord_comp_apply (hg.restrictScalars ℝ) hf I, dWirtingerDir_eq_of_clinear (clinear_of_holomorphic hg 1), DifferentiableAt.fderiv_restrictScalars ℝ hg, ContinuousLinearMap.coe_restrictScalars', fderiv_apply_one_eq_deriv, @@ -630,7 +606,7 @@ lemma dWirtingerAntiCoord_comp_holomorphic_apply {u : (ι → ℂ)} (hg : DifferentiableAt ℂ g (f u)) (hf : DifferentiableAt ℝ f u) (I : ι) : dWirtingerAntiCoord (fun v => g (f v)) I u = deriv g (f u) * dWirtingerAntiCoord f I u := by - rw [dWirtingerAntiCoord_comp_apply (hg.hasFDerivAt.restrictScalars ℝ).differentiableAt hf I, + rw [dWirtingerAntiCoord_comp_apply (hg.restrictScalars ℝ) hf I, dWirtingerDir_eq_of_clinear (clinear_of_holomorphic hg 1), DifferentiableAt.fderiv_restrictScalars ℝ hg, ContinuousLinearMap.coe_restrictScalars', fderiv_apply_one_eq_deriv, diff --git a/Physlib/Mathematics/Distribution/Basic.lean b/Physlib/Mathematics/Distribution/Basic.lean index 6cdee080b..6188fc987 100644 --- a/Physlib/Mathematics/Distribution/Basic.lean +++ b/Physlib/Mathematics/Distribution/Basic.lean @@ -413,12 +413,9 @@ lemma fderivD_const [hμ : Measure.IsAddHaarMeasure (volume (α := E))] · simp rw [integral_smul_fderiv_eq_neg_fderiv_smul_of_integrable] simp only [evalCLM_apply_apply, fderivCLM_apply, neg_neg] - · apply MeasureTheory.Integrable.smul_const - change Integrable (SchwartzMap.evalCLM (𝕜 := ℝ) E ℝ v (SchwartzMap.fderivCLM ℝ E ℝ η)) volume - exact integrable ((SchwartzMap.evalCLM ℝ E ℝ v) ((fderivCLM ℝ) E ℝ η)) + · exact (integrable ((SchwartzMap.evalCLM ℝ E ℝ v) ((fderivCLM ℝ) E ℝ η))).smul_const c · simp - · apply MeasureTheory.Integrable.smul_const - exact integrable η + · exact (integrable η).smul_const c · fun_prop · simp @@ -460,8 +457,7 @@ omit [NormedAddCommGroup E] [NormedSpace ℝ E] [BorelSpace E] [SecondCountableTopology E] in private lemma lipschitzWith_integral_of_le {μ ρ : Measure E} (hμρ : μ ≤ ρ) : LipschitzWith 1 (fun f : Lp ℂ 1 ρ => ∫ x, f x ∂μ) := by - refine LipschitzWith.of_dist_le_mul ?_ - intro f g + refine LipschitzWith.of_dist_le_mul fun f g => ?_ rw [dist_eq_norm, dist_eq_norm, NNReal.coe_one, one_mul] have hfμ : Integrable (fun x => f x) μ := memLp_one_iff_integrable.mp ((Lp.memLp f).mono_measure hμρ) @@ -482,9 +478,7 @@ private lemma lipschitzWith_integral_of_le {μ ρ : Measure E} (hμρ : μ ≤ refine ENNReal.toReal_mono hfg_top ?_ simpa [eLpNorm_one_eq_lintegral_enorm] using eLpNorm_mono_measure (p := (1 : ℝ≥0∞)) (fun x => f x - g x) hμρ - _ = ‖f - g‖ := by - rw [Lp.norm_def] - rw [eLpNorm_congr_ae hfg_ae] + _ = ‖f - g‖ := by rw [Lp.norm_def, eLpNorm_congr_ae hfg_ae] private lemma integral_boundedContinuous_eq_of_forall_schwartz_integral_eq [FiniteDimensional ℝ E] {μ ν : Measure E} [IsFiniteMeasure μ] [IsFiniteMeasure ν] @@ -492,15 +486,15 @@ private lemma integral_boundedContinuous_eq_of_forall_schwartz_integral_eq (f : BoundedContinuousFunction E ℂ) : ∫ x, f x ∂μ = ∫ x, f x ∂ν := by let ρ : Measure E := μ + ν - haveI : IsFiniteMeasure ρ := by infer_instance - haveI : ρ.HasTemperateGrowth := by infer_instance + haveI : IsFiniteMeasure ρ := inferInstance + haveI : ρ.HasTemperateGrowth := inferInstance let L : 𝓢(E, ℂ) →L[ℝ] Lp ℂ 1 ρ := SchwartzMap.toLpCLM ℝ ℂ 1 ρ let toL1 : BoundedContinuousFunction E ℂ →L[ℝ] Lp ℂ 1 ρ := BoundedContinuousFunction.toLp 1 ρ ℝ let S : Set (Lp ℂ 1 ρ) := {u | ∫ x, u x ∂μ = ∫ x, u x ∂ν} - have hS_closed : IsClosed S := by - exact isClosed_eq + have hS_closed : IsClosed S := + isClosed_eq (lipschitzWith_integral_of_le (μ := μ) (ρ := ρ) (Measure.le_add_right le_rfl)).continuous (lipschitzWith_integral_of_le (μ := ν) (ρ := ρ) @@ -547,8 +541,7 @@ private lemma measure_eq_of_forall_schwartz_integral_eq {μ ν : Measure E} [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h : ∀ η : 𝓢(E, ℂ), ∫ x, η x ∂μ = ∫ x, η x ∂ν) : μ = ν := by - apply Measure.ext_of_charFunDual - ext L + refine Measure.ext_of_charFunDual (funext fun L => ?_) rw [charFunDual_apply, charFunDual_apply] exact integral_boundedContinuous_eq_of_forall_schwartz_integral_eq h (BoundedContinuousFunction.probCharDual L) @@ -559,14 +552,9 @@ lemma ofFiniteMeasure_eq_iff [BorelSpace E] [SecondCountableTopology E] [FiniteDimensional ℝ E] {μ ν : Measure E} [IsFiniteMeasure μ] [IsFiniteMeasure ν] : ofFiniteMeasure ℂ μ = ofFiniteMeasure ℂ ν ↔ μ = ν := by - constructor - · intro hdist - apply measure_eq_of_forall_schwartz_integral_eq - intro η - rw [← ofFiniteMeasure_apply (𝕜 := ℂ) μ η, - ← ofFiniteMeasure_apply (𝕜 := ℂ) ν η, hdist] - · intro hμν - subst hμν + refine ⟨fun hdist => measure_eq_of_forall_schwartz_integral_eq fun η => ?_, ?_⟩ + · rw [← ofFiniteMeasure_apply (𝕜 := ℂ) μ η, ← ofFiniteMeasure_apply (𝕜 := ℂ) ν η, hdist] + · rintro rfl rfl end finiteMeasureExt diff --git a/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean b/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean index a6bf51cf6..3d4ee282c 100644 --- a/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean +++ b/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean @@ -96,13 +96,10 @@ lemma QuadraticMap.weightedSumSquares_basis_vector {E : Type*} [AddCommGroup E] {i : Fin (finrank ℝ E)} (v : Fin (finrank ℝ E) → ℝ) (hv : ∀ j, v j = if j = i then 1 else 0) : QuadraticMap.weightedSumSquares ℝ weights v = weights i := by - simp only [QuadraticMap.weightedSumSquares_apply] - rw [Finset.sum_eq_single i] - · simp only [hv i, ↓reduceIte, mul_one, smul_eq_mul] + rw [QuadraticMap.weightedSumSquares_apply, Finset.sum_eq_single_of_mem i (mem_univ i)] + · simp [hv i] · intro j _ hj - simp only [hv j, if_neg hj, mul_zero, smul_eq_mul] - · simp only [Finset.mem_univ, not_true_eq_false, smul_eq_mul, mul_eq_zero, or_self, - IsEmpty.forall_iff] + simp [hv j, hj] /-- When a quadratic form is equivalent to a weighted sum of squares, negative weights correspond to vectors where the form takes negative values. @@ -115,28 +112,17 @@ lemma neg_weight_implies_neg_value {E : Type*} [AddCommGroup E] [Module ℝ E] ∃ v : E, v ≠ 0 ∧ q v < 0 := by let f := Classical.choice h_equiv let v_std : Fin (finrank ℝ E) → ℝ := fun j => if j = i then 1 else 0 - let v := f.symm v_std - have hv_ne_zero : v ≠ 0 := by - intro h - have : f v = f 0 := by rw [h] - have : f (f.symm v_std) = f 0 := by rw [← this] - have : v_std = 0 := by - rw [← f.apply_symm_apply v_std] - exact Eq.trans this (map_zero f) - have : v_std i = 0 := by rw [this]; rfl - simp only [↓reduceIte, one_ne_zero, v_std] at this - have hq_neg : q v < 0 := by - have heq : q v = QuadraticMap.weightedSumSquares ℝ (fun j => (w j : ℝ)) v_std := - QuadraticMap.IsometryEquiv.map_app f.symm v_std - have hw : QuadraticMap.weightedSumSquares ℝ (fun j => (w j : ℝ)) v_std = (w i : ℝ) := by - apply QuadraticMap.weightedSumSquares_basis_vector v_std - intro j; simp only [v_std] - rw [heq, hw] - have : (w i : ℝ) = -1 := by simp only [hi, SignType.neg_eq_neg_one, SignType.coe_neg, - SignType.coe_one] - rw [this] - exact neg_one_lt_zero - exact ⟨v, hv_ne_zero, hq_neg⟩ + refine ⟨f.symm v_std, ?_, ?_⟩ + · intro h + have hz : v_std = 0 := by + have hf := congrArg f h + rwa [f.apply_symm_apply, map_zero] at hf + simpa [v_std] using congrFun hz i + · have hw : QuadraticMap.weightedSumSquares ℝ (fun j => (w j : ℝ)) v_std = (w i : ℝ) := + QuadraticMap.weightedSumSquares_basis_vector v_std fun _ => rfl + rw [QuadraticMap.IsometryEquiv.map_app f.symm v_std, hw, hi, SignType.neg_eq_neg_one, + SignType.coe_neg, SignType.coe_one] + norm_num /-- A positive definite quadratic form cannot have any negative weights in its diagonal representation. A quadratic form `q` derived from a bilinear form `b` @@ -148,9 +134,8 @@ lemma posDef_no_neg_weights {E : Type*} [AddCommGroup E] [Module ℝ E] (h_equiv : QuadraticMap.Equivalent q (QuadraticMap.weightedSumSquares ℝ fun i => (w i : ℝ))) : ∀ i, w i ≠ SignType.neg := by intro i hi - obtain ⟨v, hv_ne_zero, hq_neg⟩ := QuadraticForm.neg_weight_implies_neg_value h_equiv hi - have hq_pos : 0 < q v := hq v hv_ne_zero - exact lt_asymm hq_neg hq_pos + obtain ⟨v, hv, hq_neg⟩ := QuadraticForm.neg_weight_implies_neg_value h_equiv hi + exact lt_asymm hq_neg (hq v hv) /-- For a positive definite quadratic form, the negative dimension (index) is zero. O'Neill states (p. 47) that "ν = 0 if and only if b is positive semidefinite." @@ -163,13 +148,9 @@ theorem rankNeg_eq_zero {E : Type*} [AddCommGroup E] unfold QuadraticForm.negDim have h_exists := equivalent_signType_weighted_sum_squared q let w := Classical.choose h_exists - have h_equiv : QuadraticMap.Equivalent q - (QuadraticMap.weightedSumSquares ℝ fun i => (w i : ℝ)) := - Classical.choose_spec h_exists have h_no_neg : ∀ i, w i ≠ SignType.neg := - QuadraticForm.posDef_no_neg_weights hq h_equiv - simp [Finset.card_eq_zero, Finset.filter_eq_empty_iff] - exact fun ⦃x⦄ => h_no_neg x + QuadraticForm.posDef_no_neg_weights hq (Classical.choose_spec h_exists) + simpa [Finset.card_eq_zero, Finset.filter_eq_empty_iff] using h_no_neg end QuadraticForm @@ -304,21 +285,13 @@ lemma toQuadraticForm_apply (g : PseudoRiemannianMetric E H M n I) (x : M) @[simp] lemma toBilinForm_isSymm (g : PseudoRiemannianMetric E H M n I) (x : M) : - (toBilinForm g x).IsSymm := by - refine { eq := ?_ } - intro v w; simp only [toBilinForm_apply]; exact g.symm x v w + (toBilinForm g x).IsSymm := ⟨g.symm x⟩ @[simp] lemma toBilinForm_nondegenerate (g : PseudoRiemannianMetric E H M n I) (x : M) : (toBilinForm g x).Nondegenerate := by - unfold LinearMap.BilinForm.Nondegenerate LinearMap.Nondegenerate - LinearMap.SeparatingLeft LinearMap.SeparatingRight - constructor - · intro v hv; simp_rw [toBilinForm_apply] at hv; exact g.nondegenerate x v hv - · intro v hv; simp_rw [toBilinForm_apply] at hv; - have hw : ∀ (w : TangentSpace I x), ((g.val x) v) w = 0 := by - intro w; rw [symm]; simp [hv] - exact g.nondegenerate x v hw + refine ⟨fun v hv => g.nondegenerate x v hv, fun v hv => ?_⟩ + exact g.nondegenerate x v fun w => (g.symm x v w).trans (hv w) /-- The inner product (or scalar product) on the tangent space at point `x` induced by the pseudo-Riemannian metric `g`. This is `gₓ(v, w)`. -/ @@ -362,8 +335,8 @@ lemma flatL_apply (g : PseudoRiemannianMetric E H M n I) (x : M) (v w : TangentS @[simp] lemma flat_inj (g : PseudoRiemannianMetric E H M n I) (x : M) : Function.Injective (flat g x) := by - rw [← LinearMap.ker_eq_bot]; apply LinearMap.ker_eq_bot'.mpr - intro v hv; apply g.nondegenerate x v; intro w; exact DFunLike.congr_fun hv w + rw [← LinearMap.ker_eq_bot, LinearMap.ker_eq_bot'] + exact fun v hv => g.nondegenerate x v fun w => DFunLike.congr_fun hv w @[simp] lemma flatL_inj (g : PseudoRiemannianMetric E H M n I) (x : M) : @@ -375,28 +348,10 @@ lemma flatL_surj (g : PseudoRiemannianMetric E H M n I) (x : M) : Function.Surjective (g.flatL x) := by haveI : FiniteDimensional ℝ (TangentSpace I x) := inst_tangent_findim x - have h_finrank_eq : finrank ℝ (TangentSpace I x) = finrank ℝ (TangentSpace I x →L[ℝ] ℝ) := by - have h_dual_eq : finrank ℝ (TangentSpace I x →L[ℝ] ℝ) = finrank ℝ (Module.Dual ℝ - (TangentSpace I x)) := by - let to_dual : (TangentSpace I x →L[ℝ] ℝ) → Module.Dual ℝ (TangentSpace I x) := - fun f => f.toLinearMap - let from_dual : Module.Dual ℝ (TangentSpace I x) → (TangentSpace I x →L[ℝ] ℝ) := fun f => - ContinuousLinearMap.mk f (by - have : T2Space (TangentSpace I x) := inferInstanceAs (T2Space E) - apply LinearMap.continuous_of_finiteDimensional) - let equiv : (TangentSpace I x →L[ℝ] ℝ) ≃ₗ[ℝ] Module.Dual ℝ (TangentSpace I x) := - { toFun := to_dual, - invFun := from_dual, - map_add' := fun f g => by - ext v; unfold to_dual; simp only [LinearMap.add_apply]; rfl, - map_smul' := fun c f => by - ext v; unfold to_dual; simp only [LinearMap.smul_apply]; rfl, - left_inv := fun f => by - ext v; unfold to_dual from_dual; simp, - right_inv := fun f => by - ext v; unfold to_dual from_dual; simp } - exact LinearEquiv.finrank_eq equiv - rw [h_dual_eq, ← Subspace.dual_finrank_eq] + haveI : T2Space (TangentSpace I x) := inferInstanceAs (T2Space E) + have h_finrank_eq : finrank ℝ (TangentSpace I x) = finrank ℝ (TangentSpace I x →L[ℝ] ℝ) := + Subspace.dual_finrank_eq.symm.trans (LinearMap.toContinuousLinearMap + (𝕜 := ℝ) (E := TangentSpace I x) (F' := ℝ)).finrank_eq exact (LinearMap.injective_iff_surjective_of_finrank_eq_finrank h_finrank_eq).mp (flatL_inj g x) /-- The "musical" isomorphism (index lowering) from `TₓM` to its dual, @@ -468,35 +423,28 @@ lemma flatL_apply_sharpL @[simp] lemma flat_sharp_apply (g : PseudoRiemannianMetric E H M n I) (x : M) (ω : TangentSpace I x →L[ℝ] ℝ) : - g.flat x (g.sharp x ω) = ω := by - have := flatL_apply_sharpL g x ω - simp only [flat, sharp]; simp only [LinearEquiv.coe_coe] at this ⊢ - exact this + g.flat x (g.sharp x ω) = ω := + flatL_apply_sharpL g x ω @[simp] lemma sharp_flat_apply (g : PseudoRiemannianMetric E H M n I) (x : M) (v : TangentSpace I x) : - g.sharp x (g.flat x v) = v := by - have := sharpL_apply_flatL g x v - simp only [sharp, flat]; simp only [LinearEquiv.coe_coe] at this ⊢ - exact this + g.sharp x (g.flat x v) = v := + sharpL_apply_flatL g x v /-- The metric evaluated at `sharp ω₁` and `sharp ω₂`. -/ @[simp] lemma apply_sharp_sharp (g : PseudoRiemannianMetric E H M n I) (x : M) (ω₁ ω₂ : TangentSpace I x →L[ℝ] ℝ) : g.val x (g.sharpL x ω₁) (g.sharpL x ω₂) = ω₁ (g.sharpL x ω₂) := by - rw [← flatL_apply g x (g.sharpL x ω₁)] - rw [flatL_apply_sharpL g x ω₁] + rw [← flatL_apply g x (g.sharpL x ω₁), flatL_apply_sharpL g x ω₁] /-- The metric evaluated at `v` and `sharp ω`. -/ lemma apply_vec_sharp (g : PseudoRiemannianMetric E H M n I) (x : M) (v : TangentSpace I x) (ω : TangentSpace I x →L[ℝ] ℝ) : g.val x v (g.sharpL x ω) = ω v := by - rw [g.symm x v (g.sharpL x ω)] - rw [← flatL_apply g x (g.sharpL x ω)] - rw [flatL_apply_sharpL g x ω] + rw [g.symm x v (g.sharpL x ω), ← flatL_apply g x (g.sharpL x ω), flatL_apply_sharpL g x ω] end Sharp @@ -518,14 +466,13 @@ noncomputable def cotangentMetricVal (g : PseudoRiemannianMetric E H M n I) (x : @[simp] lemma cotangentMetricVal_eq_apply_sharp (g : PseudoRiemannianMetric E H M n I) (x : M) (ω₁ ω₂ : TangentSpace I x →L[ℝ] ℝ) : - cotangentMetricVal g x ω₁ ω₂ = ω₁ (g.sharpL x ω₂) := by - rw [cotangentMetricVal, apply_sharp_sharp] + cotangentMetricVal g x ω₁ ω₂ = ω₁ (g.sharpL x ω₂) := + apply_sharp_sharp g x ω₁ ω₂ lemma cotangentMetricVal_symm (g : PseudoRiemannianMetric E H M n I) (x : M) (ω₁ ω₂ : TangentSpace I x →L[ℝ] ℝ) : cotangentMetricVal g x ω₁ ω₂ = cotangentMetricVal g x ω₂ ω₁ := by - unfold cotangentMetricVal - rw [g.symm x (g.sharpL x ω₁) (g.sharpL x ω₂)] + simpa only [cotangentMetricVal] using g.symm x (g.sharpL x ω₁) (g.sharpL x ω₂) /-- The induced metric on the cotangent space at point `x` as a bilinear form. For covectors `ω₁` and `ω₂`, this gives `g(ω₁^#, ω₂^#)`, where `ω^#` is @@ -591,9 +538,7 @@ lemma cotangentToQuadraticForm_apply (g : PseudoRiemannianMetric E H M n I) (x : @[simp] lemma cotangentToBilinForm_isSymm (g : PseudoRiemannianMetric E H M n I) (x : M) : - (cotangentToBilinForm g x).IsSymm := by - refine { eq := ?_ } - intro ω₁ ω₂; simp only [cotangentToBilinForm_apply]; exact cotangentMetricVal_symm g x ω₁ ω₂ + (cotangentToBilinForm g x).IsSymm := ⟨cotangentMetricVal_symm g x⟩ /-- The cotangent metric is non-degenerate: if `cotangentMetricVal g x ω v = 0` for all `v`, then `ω = 0`. -/ @@ -602,34 +547,17 @@ lemma cotangentMetricVal_nondegenerate (g : PseudoRiemannianMetric E H M n I) (x cotangentMetricVal g x ω v = 0) : ω = 0 := by apply ContinuousLinearMap.ext - intro v - have h_forall : ∀ w : TangentSpace I x, ω w = 0 := by - intro w - let ω' : TangentSpace I x →L[ℝ] ℝ := g.flatL x w - have this : g.sharpL x ω' = w := by - simp only [ω', sharpL_apply_flatL] - have h_apply : cotangentMetricVal g x ω ω' = 0 := h ω' - simp only [cotangentMetricVal_eq_apply_sharp] at h_apply - rw [this] at h_apply - exact h_apply - exact h_forall v + intro w + have hw := h (g.flatL x w) + rw [cotangentMetricVal_eq_apply_sharp, sharpL_apply_flatL] at hw + simpa using hw @[simp] lemma cotangentToBilinForm_nondegenerate (g : PseudoRiemannianMetric E H M n I) (x : M) : (cotangentToBilinForm g x).Nondegenerate := by - unfold LinearMap.BilinForm.Nondegenerate LinearMap.Nondegenerate - LinearMap.SeparatingLeft LinearMap.SeparatingRight - constructor - · intro ω hω - apply cotangentMetricVal_nondegenerate g x ω - intro v - exact hω v - · intro ω hω - apply cotangentMetricVal_nondegenerate g x ω - intro v - have hv : ∀ (y : TangentSpace I x →L[ℝ] ℝ), ((g.cotangentToBilinForm x) ω) y = 0 := by - intro y; rw [LinearMap.BilinForm.isSymm_def.mp (cotangentToBilinForm_isSymm g x)]; simp [hω] - exact hv v + refine ⟨fun ω hω => cotangentMetricVal_nondegenerate g x ω hω, fun ω hω => ?_⟩ + refine cotangentMetricVal_nondegenerate g x ω fun v => ?_ + exact (cotangentMetricVal_symm g x ω v).trans (hω v) end Cotangent diff --git a/Physlib/Mathematics/InnerProductSpace/Basic.lean b/Physlib/Mathematics/InnerProductSpace/Basic.lean index f6d0b35ec..8a46fb0a2 100644 --- a/Physlib/Mathematics/InnerProductSpace/Basic.lean +++ b/Physlib/Mathematics/InnerProductSpace/Basic.lean @@ -145,11 +145,8 @@ scoped instance toNormedAddCommGroupWitL2 : NormedAddCommGroup (WithLp 2 E) := lemma norm_withLp2_eq_norm2 (x : WithLp 2 E) : ‖x‖ = |norm₂ (WithLp.equiv 2 E x)| := by - trans √ (RCLike.re ⟪WithLp.equiv 2 E x, WithLp.equiv 2 E x⟫) - · rfl - have h1 := norm₂_sq_eq_re_inner (𝕜 := 𝕜) ((WithLp.equiv 2 E) x) - rw [← h1] - exact Real.sqrt_sq_eq_abs ‖(WithLp.equiv 2 E) x‖₂ + rw [show ‖x‖ = √ (RCLike.re ⟪WithLp.equiv 2 E x, WithLp.equiv 2 E x⟫) from rfl, + ← norm₂_sq_eq_re_inner (𝕜 := 𝕜) (WithLp.equiv 2 E x), Real.sqrt_sq_eq_abs] /-- Attach normed space structure to `WithLp 2 E` with L₂ norm. -/ noncomputable @@ -220,13 +217,13 @@ def fromL2 : WithLp 2 E →L[𝕜] E where lemma fromL2_inner_left (x : WithLp 2 E) (y : E) : ⟪fromL2 𝕜 x, y⟫ = ⟪x, toL2 𝕜 y⟫ := rfl -lemma ofLp_inner_left (x : E) (y : WithLp 2 E) : ⟪WithLp.ofLp y, x⟫ = ⟪y, WithLp.toLp 2 x⟫ := by - exact fromL2_inner_left y x +lemma ofLp_inner_left (x : E) (y : WithLp 2 E) : ⟪WithLp.ofLp y, x⟫ = ⟪y, WithLp.toLp 2 x⟫ := + fromL2_inner_left y x lemma toL2_inner_left (x : E) (y : WithLp 2 E) : ⟪toL2 𝕜 x, y⟫ = ⟪x, fromL2 𝕜 y⟫ := rfl -lemma toLp_inner_left (x : WithLp 2 E) (y : E) : ⟪WithLp.toLp 2 y, x⟫ = ⟪y, WithLp.ofLp x⟫ := by - exact toL2_inner_left y x +lemma toLp_inner_left (x : WithLp 2 E) (y : E) : ⟪WithLp.toLp 2 y, x⟫ = ⟪y, WithLp.ofLp x⟫ := + toL2_inner_left y x @[simp] lemma toL2_fromL2 (x : WithLp 2 E) : toL2 𝕜 (fromL2 𝕜 x) = x := rfl @@ -270,8 +267,8 @@ lemma ext_inner_left' {x y : E} (h : ∀ v, ⟪v, x⟫ = ⟪v, y⟫) : x = y := variable (𝕜) in lemma ext_inner_right' {x y : E} (h : ∀ v, ⟪x, v⟫ = ⟪y, v⟫) : x = y := - (WithLp.equiv 2 E).symm.injective <| ext_inner_right (E := WithLp 2 E) 𝕜 <| by - exact fun v => h (WithLp.ofLp v) + (WithLp.equiv 2 E).symm.injective <| ext_inner_right (E := WithLp 2 E) 𝕜 <| + fun v => h (WithLp.ofLp v) @[simp] lemma inner_conj_symm' (x y : E) : ⟪y, x⟫† = ⟪x, y⟫ := @@ -318,24 +315,14 @@ lemma inner_self_eq_zero' {x : E} : ⟪x, x⟫ = 0 ↔ x = 0 := by @[simp] lemma inner_sum'{ι : Type*} [Fintype ι] (x : E) (g : ι → E) : - ⟪x, ∑ i, g i⟫ = ∑ i, ⟪x, g i⟫ := by - have h1 := inner_sum (𝕜 := 𝕜) (E:=WithLp 2 E) (x := WithLp.toLp 2 x) - (f := fun i => WithLp.toLp 2 (g i)) - convert h1 (Finset.univ) - · rw [← ofLp_inner_left] - simp only - congr - change _ = (WithLp.linearEquiv 2 𝕜 E) _ - simp only [map_sum, WithLp.linearEquiv_apply, AddEquiv.toEquiv_eq_coe, Equiv.toFun_as_coe, - EquivLike.coe_coe, WithLp.addEquiv_apply] - · rfl + ⟪x, ∑ i, g i⟫ = ∑ i, ⟪x, g i⟫ := + map_sum (AddMonoidHom.mk' (fun y => ⟪x, y⟫) (inner_add_right' x)) g Finset.univ @[fun_prop] lemma Continuous.inner' {α} [TopologicalSpace α] (f g : α → E) (hf : Continuous f) (hg : Continuous g) : Continuous (fun a => ⟪f a, g a⟫) := - have hf : Continuous (fun x => toL2 𝕜 (f x)) := by fun_prop - have hg : Continuous (fun x => toL2 𝕜 (g x)) := by fun_prop - Continuous.inner (𝕜:=𝕜) (E:=WithLp 2 E) hf hg + Continuous.inner (𝕜 := 𝕜) (E := WithLp 2 E) (f := fun x => toL2 𝕜 (f x)) + (g := fun x => toL2 𝕜 (g x)) (by fun_prop) (by fun_prop) section Real @@ -355,17 +342,15 @@ lemma real_inner_comm' (x y : F) : ⟪y, x⟫ = ⟪x, y⟫ := lemma ContDiffAt.inner' {f g : E → F} {x : E} (hf : ContDiffAt ℝ n f x) (hg : ContDiffAt ℝ n g x) : ContDiffAt ℝ n (fun x => ⟪f x, g x⟫) x := - have hf : ContDiffAt ℝ n (fun x => toL2 ℝ (f x)) x := by fun_prop - have hg : ContDiffAt ℝ n (fun x => toL2 ℝ (g x)) x := by fun_prop - hf.inner ℝ hg + ContDiffAt.inner ℝ (f := fun x => toL2 ℝ (f x)) (g := fun x => toL2 ℝ (g x)) + (by fun_prop) (by fun_prop) @[fun_prop] lemma ContDiff.inner' {f g : E → F} (hf : ContDiff ℝ n f) (hg : ContDiff ℝ n g) : ContDiff ℝ n (fun x => ⟪f x, g x⟫) := - have hf : ContDiff ℝ n (fun x => toL2 ℝ (f x)) := by fun_prop - have hg : ContDiff ℝ n (fun x => toL2 ℝ (g x)) := by fun_prop - hf.inner ℝ hg + ContDiff.inner ℝ (f := fun x => toL2 ℝ (f x)) (g := fun x => toL2 ℝ (g x)) + (by fun_prop) (by fun_prop) end Real @@ -570,37 +555,23 @@ lemma _root_.isBoundedBilinearMap_inner' : simp_all intro x y trans |‖x‖₂| * |‖y‖₂| - · change |@inner ℝ (WithLp 2 E) _ _ _| ≤ _ - have h1 := norm_inner_le_norm (𝕜 := ℝ) (E := WithLp 2 E) (WithLp.toLp 2 x) (WithLp.toLp 2 y) - simp at h1 - apply h1.trans - apply le_of_eq - congr - · rw [norm_withLp2_eq_norm2] - rfl - · rw [norm_withLp2_eq_norm2] - rfl + · refine (norm_inner_le_norm (𝕜 := ℝ) (E := WithLp 2 E) (WithLp.toLp 2 x) + (WithLp.toLp 2 y)).trans ?_ + simp [norm_withLp2_eq_norm2] · have key (z : E) : |‖z‖₂| ≤ √ d * ‖z‖ := by apply le_of_sq_le_sq · simp [@mul_pow] rw [norm₂_sq_eq_re_inner (𝕜 := ℝ)] simp only [re_to_real] - apply (h z).2.trans - apply le_of_eq - simp only [mul_eq_mul_right_iff, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, - pow_eq_zero_iff, norm_eq_zero] - left - refine Eq.symm (Real.sq_sqrt ?_) - linarith + rw [Real.sq_sqrt (by linarith : (0:ℝ) ≤ d)] + exact (h z).2 · positivity have h1 := key x have h2 := key y trans (√ d * ‖x‖) * (√ d * ‖y‖) · exact mul_le_mul_of_nonneg h1 h2 (by positivity) (by positivity) · apply le_of_eq - ring_nf - rw [Real.sq_sqrt] - · ring - · linarith + rw [mul_mul_mul_comm, Real.mul_self_sqrt (by linarith : (0:ℝ) ≤ d)] + ring end Constructions diff --git a/Physlib/Mathematics/List.lean b/Physlib/Mathematics/List.lean index d2c0fa4e4..d791b0d1b 100644 --- a/Physlib/Mathematics/List.lean +++ b/Physlib/Mathematics/List.lean @@ -88,7 +88,7 @@ lemma dropWile_eraseIdx {I : Type} (P : I → Prop) [DecidablePred P] : lemma insertionSort_length {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (l : List I) : (List.insertionSort le1 l).length = l.length := - List.Perm.length_eq (List.perm_insertionSort le1 l) + List.length_insertionSort le1 l /-- The position `r0` ends up in `r` on adding it via `List.orderedInsert _ r0 r`. -/ @[expose] @@ -103,9 +103,7 @@ def orderedInsertPos {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (r : lemma orderedInsertPos_lt_length {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (r : List I) (r0 : I) : orderedInsertPos le1 r r0 < (r0 :: r).length := by simp only [orderedInsertPos, List.length_cons] - have h1 : (List.takeWhile (fun b => decide ¬le1 r0 b) r).length ≤ r.length := - List.Sublist.length_le (List.takeWhile_sublist fun b => decide ¬le1 r0 b) - omega + exact Nat.lt_succ_of_le (List.takeWhile_sublist _).length_le @[simp] lemma orderedInsert_get_orderedInsertPos {I : Type} (le1 : I → I → Prop) [DecidableRel le1] @@ -218,8 +216,7 @@ lemma lt_orderedInsertPos_rel {I : Type} (le1 : I → I → Prop) [DecidableRel have htake : r.get n ∈ List.take (orderedInsertPos le1 r r0) r := by rw [@List.mem_take_iff_getElem] use n - simp only [List.get_eq_getElem, lt_inf_iff, Fin.is_lt, and_true, exists_prop] - exact hn + simpa only [List.get_eq_getElem, lt_inf_iff, Fin.is_lt, and_true, exists_prop] using hn rw [orderedInsertPos_take] at htake simpa using List.mem_takeWhile_imp htake @@ -229,9 +226,8 @@ lemma lt_orderedInsertPos_rel_fin {I : Type} (le1 : I → I → Prop) [Decidable have htake : (List.orderedInsert le1 r0 r).get n ∈ List.take (orderedInsertPos le1 r r0) r := by rw [orderedInsertPos_take_eq_orderedInsert, List.mem_take_iff_getElem] use n - simp only [List.get_eq_getElem, Fin.is_le', inf_of_le_left, Fin.val_fin_lt, exists_prop, - and_true] - exact hn + simpa only [List.get_eq_getElem, Fin.is_le', inf_of_le_left, Fin.val_fin_lt, exists_prop, + and_true] using hn rw [orderedInsertPos_take] at htake simpa using List.mem_takeWhile_imp htake @@ -239,9 +235,8 @@ lemma gt_orderedInsertPos_rel {I : Type} (le1 : I → I → Prop) [DecidableRel [Std.Total le1] [IsTrans I le1] (r0 : I) (r : List I) (hs : List.Pairwise le1 r) (n : Fin r.length) (hn : ¬ n.val < (orderedInsertPos le1 r r0).val) : le1 r0 (r.get n) := by - have hrsSorted : List.Pairwise le1 (List.orderedInsert le1 r0 r) := - List.Pairwise.orderedInsert r0 r hs - apply List.Pairwise.rel_of_mem_take_of_mem_drop (i := (orderedInsertPos le1 r r0).succ) hrsSorted + apply List.Pairwise.rel_of_mem_take_of_mem_drop (i := (orderedInsertPos le1 r r0).succ) + (List.Pairwise.orderedInsert r0 r hs) · rw [orderedInsertPos_succ_take_orderedInsert] simp · rw [← orderedInsertPos_drop_eq_orderedInsert] @@ -326,9 +321,7 @@ lemma orderedInsertEquiv_succ {I : Type} (le1 : I → I → Prop) [DecidableRel simp only [List.length_cons, orderedInsertEquiv, Nat.succ_eq_add_one, Equiv.trans_apply] match r with | [] => - simp only [List.length_nil, Nat.reduceAdd, Fin.val_eq_zero, Fin.zero_eta, Fin.isValue, - Equiv.symm_apply_apply, OrderIso.coe_symm_toEquiv, Fin.symm_castOrderIso, - Fin.castOrderIso_apply, Fin.cast_mk, Fin.zero_succAbove, Fin.succ_mk] + simp | r1 :: r => simp only [List.length_cons] rw [finExtractOne_apply_neq] @@ -345,9 +338,7 @@ lemma orderedInsertEquiv_fin_succ {I : Type} (le1 : I → I → Prop) [Decidable simp only [orderedInsertEquiv, Equiv.trans_apply] match r with | [] => - simp only [List.length_cons, List.length_nil, Nat.reduceAdd, Fin.val_eq_zero, Fin.zero_eta, - Fin.isValue, Equiv.symm_apply_apply, OrderIso.coe_symm_toEquiv, Fin.symm_castOrderIso, - Fin.castOrderIso_apply, Fin.eta, Fin.zero_succAbove] + simp | r1 :: r => simp only [List.length_cons, Fin.eta] rw [finExtractOne_apply_neq] @@ -363,8 +354,7 @@ lemma orderedInsertEquiv_monotone_fin_succ {I : Type} n < m := by rw [orderedInsertEquiv_fin_succ, orderedInsertEquiv_fin_succ, Fin.lt_def] at hx simp only [Fin.eta, Fin.val_cast, Fin.val_fin_lt] at hx - rw [Fin.succAbove_lt_succAbove_iff] at hx - exact hx + rwa [Fin.succAbove_lt_succAbove_iff] at hx lemma orderedInsertEquiv_congr {α : Type} {r : α → α → Prop} [DecidableRel r] (a : α) (l l' : List α) (h : l = l') : @@ -412,9 +402,8 @@ lemma get_eq_orderedInsertEquiv {I : Type} (le1 : I → I → Prop) [DecidableRe lemma orderedInsertEquiv_get {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (r : List I) (r0 : I) : (r0 :: r).get ∘ (orderedInsertEquiv le1 r r0).symm = (List.orderedInsert le1 r0 r).get := by - rw [get_eq_orderedInsertEquiv le1] funext x - simp + simp [get_eq_orderedInsertEquiv le1] lemma orderedInsert_eraseIdx_orderedInsertEquiv_zero {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (r : List I) (r0 : I) : @@ -446,11 +435,7 @@ lemma orderedInsert_eraseIdx_orderedInsertEquiv_fin_succ (hr : ∀ (i j : Fin r.length), i < j → ¬le1 r0 (r.get j) → ¬le1 r0 (r.get i)) : (List.orderedInsert le1 r0 r).eraseIdx (orderedInsertEquiv le1 r r0 n.succ) = (List.orderedInsert le1 r0 (r.eraseIdx n)) := by - have hn : n.succ = ⟨n.val + 1, by omega⟩ := by - rw [Fin.ext_iff] - rfl - rw [hn] - exact orderedInsert_eraseIdx_orderedInsertEquiv_succ le1 r r0 n.val _ hr + exact orderedInsert_eraseIdx_orderedInsertEquiv_succ le1 r r0 n.val (Nat.succ_lt_succ n.isLt) hr lemma orderedInsertEquiv_sigma {I : Type} {f : I → Type} (le1 : I → I → Prop) [DecidableRel le1] (l : List (Σ i, f i)) @@ -482,8 +467,7 @@ lemma orderedInsert_eq_insertIdx_orderedInsertPos {I : Type} (le1 : I → I → apply List.ext_get · simp only [List.orderedInsert_length] rw [List.length_insertIdx] - have h1 := orderedInsertPos_lt_length le1 r r0 - exact (if_pos (Nat.le_of_succ_le_succ h1)).symm + exact (if_pos (Nat.le_of_succ_le_succ (orderedInsertPos_lt_length le1 r r0))).symm intro n h1 h2 obtain ⟨n', hn'⟩ := (orderedInsertEquiv le1 r r0).surjective ⟨n, h1⟩ rw [← hn'] @@ -567,14 +551,12 @@ lemma insertionSortEquiv_congr_apply {α : Type} {r : α → α → Prop} [Decid lemma insertionSort_get_comp_insertionSortEquiv {α : Type} {r : α → α → Prop} [DecidableRel r] (l : List α) : (List.insertionSort r l).get ∘ (insertionSortEquiv r l) = l.get := by - rw [← insertionSortEquiv_get] funext x - simp + simp [← insertionSortEquiv_get] lemma insertionSort_eq_ofFn {α : Type} {r : α → α → Prop} [DecidableRel r] (l : List α) : List.insertionSort r l = List.ofFn (l.get ∘ (insertionSortEquiv r l).symm) := by - rw [insertionSortEquiv_get (r := r)] - exact (List.ofFn_get (List.insertionSort r l)).symm + rw [insertionSortEquiv_get (r := r), List.ofFn_get] lemma insertionSortEquiv_order {α : Type} {r : α → α → Prop} [DecidableRel r] : (l : List α) → (i : Fin l.length) → (j : Fin l.length) → (hij : i < j) @@ -587,7 +569,6 @@ lemma insertionSortEquiv_order {α : Type} {r : α → α → Prop} [DecidableRe nth_rewrite 2 [insertionSortEquiv] at hij' simp only [List.length_cons, Nat.succ_eq_add_one, Fin.zero_eta, Equiv.trans_apply, equivCons_zero] at hij' - have hx := orderedInsertEquiv_zero r (List.insertionSort r as) a convert lt_orderedInsertPos_rel_fin r a (List.insertionSort r as) _ hij' change _ = ((List.insertionSort r (a :: as))).get ((insertionSortEquiv r (a :: as)) ⟨j + 1, hj⟩) rw [← insertionSortEquiv_get] @@ -595,10 +576,9 @@ lemma insertionSortEquiv_order {α : Type} {r : α → α → Prop} [DecidableRe | a :: as, ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, hij, hij' => by simp only [List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, Equiv.trans_apply, equivCons_succ] at hij' - have h1 := orderedInsertEquiv_monotone_fin_succ _ _ _ _ _ hij' - have h2 := insertionSortEquiv_order as ⟨i, Nat.succ_lt_succ_iff.mp hi⟩ - ⟨j, Nat.succ_lt_succ_iff.mp hj⟩ (by simpa using hij) h1 - simpa using h2 + simpa using insertionSortEquiv_order as ⟨i, Nat.succ_lt_succ_iff.mp hi⟩ + ⟨j, Nat.succ_lt_succ_iff.mp hj⟩ (by simpa using hij) + (orderedInsertEquiv_monotone_fin_succ _ _ _ _ _ hij') /-- Optional erase of an element in a list. For `none` returns the list, for `some i` returns the list with the `i`'th element erased. -/ @@ -612,16 +592,12 @@ lemma eraseIdx_length' {I : Type} (l : List I) (i : Fin l.length) : simp [List.length_eraseIdx] lemma eraseIdx_length {I : Type} (l : List I) (i : Fin l.length) : - (List.eraseIdx l i).length + 1 = l.length := by - simp only [List.length_eraseIdx, Fin.is_lt, ↓reduceIte] - have hi := i.prop - omega + (List.eraseIdx l i).length + 1 = l.length := + List.length_eraseIdx_add_one i.isLt lemma eraseIdx_length_succ {I : Type} (l : List I) (i : Fin l.length) : - (List.eraseIdx l i).length.succ = l.length := by - simp only [List.length_eraseIdx, Fin.is_lt, ↓reduceIte] - have hi := i.prop - omega + (List.eraseIdx l i).length.succ = l.length := + List.length_eraseIdx_add_one i.isLt lemma eraseIdx_cons_length {I : Type} (a : I) (l : List I) (i : Fin (a :: l).length) : (List.eraseIdx (a :: l) i).length= l.length := by @@ -703,9 +679,7 @@ lemma insertionSortMin_eq_insertionSort_head {α : Type} (r : α → α → Prop rw [insertionSort_length]; exact Nat.zero_lt_succ l.length⟩) · rw [← insertionSortEquiv_get] rfl - · exact List.get_mk_zero - (Eq.mpr (id (congrArg (fun _a => 0 < _a) (insertionSort_length r (i :: l)))) - (Nat.zero_lt_succ l.length)) + · exact List.get_mk_zero _ /-- The list remaining after dropping the element at the position determined by `insertionSortMinPos`. -/ @@ -769,7 +743,6 @@ lemma mem_take_finrange : (n m : ℕ) → (a : Fin n) → a ∈ List.take m (Lis · intro h1 use ⟨i, Nat.succ_lt_succ_iff.mp h⟩ simp only [Fin.succ_mk, and_true] - rw [mem_take_finrange n m ⟨i, Nat.succ_lt_succ_iff.mp h⟩] - exact h1 + rwa [mem_take_finrange n m ⟨i, Nat.succ_lt_succ_iff.mp h⟩] end Physlib.List diff --git a/Physlib/Mathematics/List/InsertionSort.lean b/Physlib/Mathematics/List/InsertionSort.lean index 7d2b893f7..e1bec708b 100644 --- a/Physlib/Mathematics/List/InsertionSort.lean +++ b/Physlib/Mathematics/List/InsertionSort.lean @@ -22,10 +22,7 @@ variable {n : Nat} lemma insertionSortMin_lt_length_succ {α : Type} (r : α → α → Prop) [DecidableRel r] (i : α) (l : List α) : insertionSortMinPos r i l < (insertionSortDropMinPos r i l).length.succ := by - rw [insertionSortMinPos] - simp only [List.length_cons, insertionSortDropMinPos, Nat.succ_eq_add_one] - rw [eraseIdx_length'] - simp + simp [insertionSortMinPos, insertionSortDropMinPos, eraseIdx_length'] /-- Given a list `i :: l` the left-most minimal position `a` of `i :: l` wrt `r` as an element of `Fin (insertionSortDropMinPos r i l).length.succ`. -/ @@ -37,11 +34,9 @@ lemma insertionSortMin_lt_mem_insertionSortDropMinPos {α : Type} (r : α → α [Std.Total r] [IsTrans α r] (a : α) (l : List α) (i : Fin (insertionSortDropMinPos r a l).length) : r (insertionSortMin r a l) ((insertionSortDropMinPos r a l)[i]) := by - have hl1 : (List.insertionSort r (a :: l)).Pairwise r := List.pairwise_insertionSort r (a :: l) - rw [insertionSort_eq_insertionSortMin_cons r a l] at hl1 - simp only [List.pairwise_cons, List.mem_insertionSort] at hl1 - apply hl1.1 ((insertionSortDropMinPos r a l)[i]) - simp + have hl1 := List.pairwise_insertionSort r (a :: l) + rw [insertionSort_eq_insertionSortMin_cons r a l, List.pairwise_cons] at hl1 + exact hl1.1 _ (by simp) lemma insertionSortMinPos_insertionSortEquiv {α : Type} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) : @@ -58,8 +53,7 @@ lemma insertionSortEquiv_gt_zero_of_ne_insertionSortMinPos {α : Type} (r : α simp only [List.length_cons, not_lt] at hn refine hk ((Equiv.apply_eq_iff_eq_symm_apply (insertionSortEquiv r (a :: l))).mp ?_) simp_all only [List.length_cons, ne_eq, Fin.le_def, nonpos_iff_eq_zero] - simp only [Fin.ext_iff] - omega + exact Fin.ext hn lemma insertionSortMin_lt_mem_insertionSortDropMinPos_of_lt {α : Type} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) @@ -107,9 +101,8 @@ lemma orderedInsert_commute {α : Type} (r : α → α → Prop) [DecidableRel r simp only [List.orderedInsert] by_cases h : r a c · simp only [h, ↓reduceIte, List.orderedInsert.eq_2, hrb] - rw [if_pos] + rw [if_pos (IsTrans.trans (r := r) _ _ _ hrb h)] simp only [List.orderedInsert, hr, ↓reduceIte, h] - exact IsTrans.trans (r :=r) _ _ _ hrb h · simp only [h, ↓reduceIte, List.orderedInsert.eq_2] by_cases hbc : r b c · simp [hbc, hr, h] @@ -136,8 +129,7 @@ lemma insertionSort_insertionSort_append {α : Type} (r : α → α → Prop) [D | [], l2 => by simp | a :: l1, l2 => by - conv_lhs => simp - rw [insertionSort_orderedInsert_append] + rw [List.insertionSort_cons, insertionSort_orderedInsert_append] simp only [List.cons_append, List.insertionSort_cons] rw [insertionSort_insertionSort_append r l1 l2] @@ -146,8 +138,7 @@ lemma insertionSort_append_insertionSort_append {α : Type} (r : α → α → P List.insertionSort r (l1 ++ List.insertionSort r l2 ++ l3) = List.insertionSort r (l1 ++ l2 ++ l3) | [], l2, l3 => by - simp only [List.nil_append] - exact insertionSort_insertionSort_append r l2 l3 + simpa using insertionSort_insertionSort_append r l2 l3 | a :: l1, l2, l3 => by simp only [List.cons_append, List.insertionSort_cons] rw [insertionSort_append_insertionSort_append r l1 l2 l3] @@ -298,8 +289,8 @@ lemma insertionSortEquiv_orderedInsert_append {α : Type} (r : α → α → Pro conv_lhs => simp [insertionSortEquiv] rw [insertionSortEquiv_orderedInsert_append r a] have hl : (List.insertionSort r (List.orderedInsert r a l1 ++ a2 :: l2)) = - List.insertionSort r (a :: l1 ++ a2 :: l2) := by - exact insertionSort_orderedInsert_append r a l1 (a2 :: l2) + List.insertionSort r (a :: l1 ++ a2 :: l2) := + insertionSort_orderedInsert_append r a l1 (a2 :: l2) rw [orderedInsertEquiv_congr _ _ _ hl] conv_lhs => enter [2, 1, 2, 1] @@ -381,12 +372,7 @@ lemma orderedInsert_filter_of_pos {α : Type} (r : α → α → Prop) [Decidabl apply hc apply IsTrans.trans a b _ hab simp only [List.pairwise_cons] at hl - apply hl.1 - have hlf : (List.filter (fun b => decide (p b)) l)[0] ∈ - (List.filter (fun b => decide (p b)) l) := by - exact List.getElem_mem c - simp only [List.mem_filter, decide_eq_true_eq] at hlf - exact hlf.1 + exact hl.1 _ (List.mem_filter.mp (List.getElem_mem c)).1 rw [hl] simp only [decide_not, List.nil_append, List.cons.injEq, true_and] conv_lhs => rw [← List.takeWhile_append_dropWhile (p := fun b => decide ¬r a b) @@ -404,11 +390,7 @@ lemma orderedInsert_filter_of_neg {α : Type} (r : α → α → Prop) [Decidabl List.filter p (List.orderedInsert r a l) = (List.filter p l) := by rw [List.orderedInsert_eq_take_drop] simp only [decide_not, List.filter_append] - rw [List.filter_cons_of_neg] - rw [← List.filter_append] - congr - exact List.takeWhile_append_dropWhile - simp [h] + rw [List.filter_cons_of_neg (by simp [h]), ← List.filter_append, List.takeWhile_append_dropWhile] lemma insertionSort_filter {α : Type} (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] (p : α → Prop) [DecidablePred p] : (l : List α) → @@ -418,13 +400,12 @@ lemma insertionSort_filter {α : Type} (r : α → α → Prop) [DecidableRel r] | a :: l => by simp only [List.insertionSort_cons] by_cases h : p a - · rw [orderedInsert_filter_of_pos r a p h _ (List.pairwise_insertionSort r l)] - rw [List.filter_cons_of_pos (by simpa using h)] + · rw [orderedInsert_filter_of_pos r a p h _ (List.pairwise_insertionSort r l), + List.filter_cons_of_pos (by simpa using h)] simp only [List.insertionSort_cons] rw [insertionSort_filter] - · rw [orderedInsert_filter_of_neg r a p h] - rw [List.filter_cons_of_neg (by simpa using h)] - rw [insertionSort_filter] + · rw [orderedInsert_filter_of_neg r a p h, List.filter_cons_of_neg (by simpa using h), + insertionSort_filter] lemma takeWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [DecidableRel r] [IsTrans α r] (a : α) : (l : List α) → (hl : l.Pairwise r) → @@ -439,9 +420,7 @@ lemma takeWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [Decidable · simp_all only [Decidable.not_not, decide_not, decide_true, Bool.not_true, Bool.false_eq_true, not_false_eq_true, List.takeWhile_cons_of_neg, List.filter_cons_of_neg, List.nil_eq, List.filter_eq_nil_iff, Bool.not_eq_eq_eq_not, decide_eq_false_iff_not] - intro c hc - apply IsTrans.trans a b c hb - exact hl.1 c hc + exact fun c hc => IsTrans.trans a b c hb (hl.1 c hc) lemma dropWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [DecidableRel r] [IsTrans α r] (a : α) : (l : List α) → (hl : l.Pairwise r) → @@ -459,9 +438,7 @@ lemma dropWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [Decidable symm rw [List.filter_eq_self] intro c hc - simp only [decide_eq_true_eq] - apply IsTrans.trans a b c hb - exact hl.1 c hc + simpa using IsTrans.trans a b c hb (hl.1 c hc) lemma dropWhile_sorted_eq_filter_filter {α : Type} (r : α → α → Prop) [DecidableRel r] [IsTrans α r] (a : α) :(l : List α) → (hl : l.Pairwise r) → @@ -480,8 +457,7 @@ lemma dropWhile_sorted_eq_filter_filter {α : Type} (r : α → α → Prop) [De by_cases hba : r b a · simp only [hba, decide_true, Bool.not_true, Bool.and_false, Bool.false_eq_true, not_false_eq_true, List.filter_cons_of_neg] - rw [List.filter_cons_of_pos] - rw [dropWhile_sorted_eq_filter_filter] + rw [List.filter_cons_of_pos, dropWhile_sorted_eq_filter_filter] simp only [Bool.decide_and, decide_not, List.cons_append] exact hl.2 simp_all @@ -492,11 +468,8 @@ lemma dropWhile_sorted_eq_filter_filter {α : Type} (r : α → α → Prop) [De intro c hc simp only [Bool.and_eq_true, decide_eq_true_eq, not_and] intro hac hca - apply hba - apply IsTrans.trans b c a _ hca - exact hl.1 c hc - rw [h1] - rw [dropWhile_sorted_eq_filter_filter] + exact hba (IsTrans.trans b c a (hl.1 c hc) hca) + rw [h1, dropWhile_sorted_eq_filter_filter] simp only [Bool.decide_and, h1, decide_not, List.nil_append] rw [List.filter_cons_of_pos] simp_all only [List.filter_eq_nil_iff, Bool.and_eq_true, decide_eq_true_eq, not_and, @@ -512,7 +485,7 @@ lemma filter_rel_eq_insertionSort {α : Type} (r : α → α → Prop) [Decidabl simp only [List.insertionSort] by_cases h : r a b ∧ r b a · have hl := orderedInsert_filter_of_pos r b (fun c => r a c ∧ r c a) h - (List.insertionSort r l) (by exact List.pairwise_insertionSort r l) + (List.insertionSort r l) (List.pairwise_insertionSort r l) simp only [Bool.decide_and] at hl ⊢ erw [hl] rw [List.orderedInsert_eq_take_drop] @@ -579,17 +552,15 @@ lemma insertionSort_of_eq_list {α : Type} (r : α → α → Prop) [DecidableRe exact List.pairwise_insertionSort r (l1 ++ l ++ l2) conv_lhs => rw [← List.takeWhile_append_dropWhile (p := fun c => decide ¬ r a c) (l := (l1 ++ l ++ l2).insertionSort r), hlt] - simp only [decide_not, Bool.decide_and] - simp only [List.append_assoc, List.append_cancel_left_eq] + simp only [decide_not, Bool.decide_and, List.append_assoc, List.append_cancel_left_eq] have h1 := dropWhile_sorted_eq_filter r a (List.insertionSort r (l1 ++ (l ++ l2))) simp only [decide_not] at h1 - rw [h1] - rw [dropWhile_sorted_eq_filter_filter, filter_rel_eq_insertionSort] + rw [h1, dropWhile_sorted_eq_filter_filter, filter_rel_eq_insertionSort] simp only [Bool.decide_and, List.filter_append, decide_not, List.append_assoc, List.append_cancel_left_eq] congr 1 simp only [List.filter_eq_self, Bool.and_eq_true, decide_eq_true_eq] - exact fun a a_1 => h a a_1 + exact h congr 1 have h1 := insertionSort_filter r (fun c => decide (r a c) && !decide (r c a)) (l1 ++ (l ++ l2)) simp only [Bool.and_eq_true, decide_eq_true_eq, Bool.not_eq_eq_eq_not, Bool.not_true, @@ -616,10 +587,6 @@ lemma insertionSort_of_takeWhile_filter {α : Type} (r : α → α → Prop) [De ++ (List.filter (fun c => r a c ∧ r c a) l1) ++ (List.filter (fun c => r a c ∧ r c a) l2) ++ (List.filter (fun c => r a c ∧ ¬ r c a) ((l1 ++ l2).insertionSort r)) := by - trans List.insertionSort r (l1 ++ [] ++ l2) - simp only [List.append_nil] - rw [insertionSort_of_eq_list r a l1 [] l2] - simp only [decide_not, Bool.decide_and, List.append_nil, List.append_assoc] - simp + simpa using insertionSort_of_eq_list r a l1 [] l2 (by simp) end Physlib.List diff --git a/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean b/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean index 68d76cc46..91c13a45b 100644 --- a/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean +++ b/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean @@ -51,16 +51,13 @@ lemma physHermite_one : physHermite 1 = 2 * X := by simp [physHermite_succ] lemma derivative_physHermite_succ : (n : ℕ) → derivative (physHermite (n + 1)) = 2 * (n + 1) • physHermite n - | 0 => by - simp [physHermite_one] + | 0 => by simp [physHermite_one] | n + 1 => by rw [physHermite_succ] - simp only [nsmul_eq_mul, Nat.cast_ofNat, derivative_sub, derivative_mul, derivative_ofNat, - zero_mul, derivative_X, mul_one, zero_add, Nat.cast_add, Nat.cast_one] - rw [derivative_physHermite_succ] - simp only [physHermite_succ, nsmul_eq_mul, Nat.cast_ofNat, Nat.cast_add, Nat.cast_one, - derivative_mul, derivative_ofNat, zero_mul, derivative_add, derivative_natCast, - derivative_one, add_zero, zero_add] + simp only [derivative_physHermite_succ n, nsmul_eq_mul, Nat.cast_ofNat, Nat.cast_add, + Nat.cast_one, derivative_sub, derivative_mul, derivative_ofNat, zero_mul, derivative_X, + mul_one, zero_add, derivative_add, derivative_natCast, derivative_one, add_zero] + simp only [physHermite_succ, nsmul_eq_mul] ring lemma derivative_physHermite : (n : ℕ) → @@ -88,8 +85,8 @@ lemma coeff_physHermite_of_lt {n k : ℕ} (hnk : n < k) : coeff (physHermite n) induction n generalizing k with | zero => exact coeff_C | succ n ih => - have : n + k + 1 + 2 = n + (k + 2) + 1 := by ring - rw [coeff_physHermite_succ_succ, add_right_comm, this, ih k, ih (k + 2), mul_zero] + rw [coeff_physHermite_succ_succ, add_right_comm, show n + k + 1 + 2 = n + (k + 2) + 1 by ring, + ih k, ih (k + 2)] simp @[simp] @@ -97,39 +94,34 @@ lemma coeff_physHermite_self_succ (n : ℕ) : coeff (physHermite n) n = 2 ^ n := induction n with | zero => exact coeff_C | succ n ih => - rw [coeff_physHermite_succ_succ, ih, coeff_physHermite_of_lt, mul_zero, sub_zero] - · rw [← Int.pow_succ'] - · simp + rw [coeff_physHermite_succ_succ, ih, coeff_physHermite_of_lt (by omega), mul_zero, sub_zero, + ← Int.pow_succ'] @[simp] lemma degree_physHermite (n : ℕ) : degree (physHermite n) = n := by - rw [degree_eq_of_le_of_coeff_ne_zero] - · simp_rw [degree_le_iff_coeff_zero, Nat.cast_lt] - rintro m hnm - exact coeff_physHermite_of_lt hnm - · simp + refine degree_eq_of_le_of_coeff_ne_zero ?_ (by simp) + simp_rw [degree_le_iff_coeff_zero, Nat.cast_lt] + exact fun _ => coeff_physHermite_of_lt @[simp] lemma natDegree_physHermite {n : ℕ} : (physHermite n).natDegree = n := natDegree_eq_of_degree_eq_some (degree_physHermite n) lemma iterate_derivative_physHermite_of_gt {n m : ℕ} (h : n < m) : - derivative^[m] (physHermite n) = 0 := by - refine iterate_derivative_eq_zero ?_ - simpa using h + derivative^[m] (physHermite n) = 0 := + iterate_derivative_eq_zero (by simpa using h) open Nat @[simp] lemma iterate_derivative_physHermite_self {n : ℕ} : derivative^[n] (physHermite n) = C ((n ! : ℤ) * 2 ^ n) := by - refine coeff_inj.mp ?_ - funext m + ext m rw [Polynomial.coeff_iterate_derivative] match m with | 0 => rw [Polynomial.coeff_C_zero] - simp [coeff_physHermite_self_succ, Nat.descFactorial_self] + simp [Nat.descFactorial_self] | m + 1 => rw [coeff_physHermite_of_lt (by omega), Polynomial.coeff_C_of_ne_zero (by omega)] rfl @@ -139,9 +131,8 @@ lemma physHermite_leadingCoeff {n : ℕ} : (physHermite n).leadingCoeff = 2 ^ n simp [leadingCoeff] @[simp] -lemma physHermite_ne_zero {n : ℕ} : physHermite n ≠ 0 := by - refine leadingCoeff_ne_zero.mp ?_ - simp +lemma physHermite_ne_zero {n : ℕ} : physHermite n ≠ 0 := + leadingCoeff_ne_zero.mp (by simp) noncomputable instance : CoeFun (Polynomial ℤ) (fun _ ↦ ℝ → ℝ)where coe p := fun x => p.aeval x @@ -158,21 +149,20 @@ lemma physHermite_succ_fun (n : ℕ) : (physHermite (n + 1) : ℝ → ℝ) = 2 • (fun x => x) * (physHermite n : ℝ → ℝ)- (2 * n : ℝ) • (physHermite (n - 1) : ℝ → ℝ) := by ext x - simp [physHermite_succ', aevalEquiv, aeval, mul_assoc] + simp [physHermite_succ', mul_assoc, map_ofNat] lemma physHermite_succ_fun' (n : ℕ) : (physHermite (n + 1) : ℝ → ℝ) = fun x => 2 • x * physHermite n x - (2 * n : ℝ) • physHermite (n - 1) x := by - ext x - simp [physHermite_succ', aevalEquiv, aeval, mul_assoc] + rw [physHermite_succ_fun] + rfl lemma iterated_deriv_physHermite_eq_aeval (n : ℕ) : (m : ℕ) → deriv^[m] (physHermite n) = fun x => (derivative^[m] (physHermite n)).aeval x | 0 => by simp | m + 1 => by - simp only [Function.iterate_succ_apply'] - rw [iterated_deriv_physHermite_eq_aeval n m] + simp only [Function.iterate_succ_apply', iterated_deriv_physHermite_eq_aeval n m] funext x rw [Polynomial.deriv_aeval] @@ -182,26 +172,24 @@ lemma physHermite_differentiableAt (n : ℕ) (x : ℝ) : @[fun_prop] lemma deriv_physHermite_differentiableAt (n m : ℕ) (x : ℝ) : - DifferentiableAt ℝ (deriv^[m] (physHermite n)) x := by - rw [iterated_deriv_physHermite_eq_aeval] - exact Polynomial.differentiableAt_aeval _ + DifferentiableAt ℝ (deriv^[m] (physHermite n)) x := + iterated_deriv_physHermite_eq_aeval n m ▸ Polynomial.differentiableAt_aeval _ lemma deriv_physHermite (n : ℕ) : deriv (physHermite n) = 2 * n * (physHermite (n - 1)) := by ext x rw [Polynomial.deriv_aeval (physHermite n), derivative_physHermite] - simp [aeval, aevalEquiv, mul_assoc] + simp [mul_assoc, map_ofNat] lemma fderiv_physHermite {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (x : E) (f : E → ℝ) (hf : DifferentiableAt ℝ f x) (n : ℕ) : fderiv ℝ (fun x => physHermite n (f x)) x = (2 * n * physHermite (n - 1) (f x)) • fderiv ℝ f x := by - have h := fderiv_comp (𝕜 := ℝ) (g := physHermite n) (f := f) (hg := by fun_prop) - (hf := by fun_prop) - simp +unfoldPartialApp only [Function.comp] at h + rw [show (fun x => physHermite n (f x)) = physHermite n ∘ f from rfl, + fderiv_comp x (by fun_prop) hf] ext dx - simp only [h, Polynomial.fderiv_aeval, derivative_physHermite, nsmul_eq_mul, map_mul, map_natCast, + simp only [Polynomial.fderiv_aeval, derivative_physHermite, nsmul_eq_mul, map_mul, map_natCast, ContinuousLinearMap.coe_comp, Function.comp_apply, ContinuousLinearMap.smulRight_apply, one_apply_eq_self, smul_eq_mul, FunLike.coe_smul, Pi.smul_apply, map_ofNat] ring @@ -212,20 +200,17 @@ lemma deriv_physHermite' (x : ℝ) deriv (fun x => physHermite n (f x)) x = (2 * n * physHermite (n - 1) (f x)) * deriv f x := by unfold deriv - rw [fderiv_physHermite (hf := by fun_prop)] + rw [fderiv_physHermite (hf := hf)] rfl lemma physHermite_parity: (n : ℕ) → (x : ℝ) → physHermite n (-x) = (-1)^n * physHermite n x | 0, x => by simp - | 1, x => by - simp [physHermite_one, aeval, aevalEquiv] + | 1, x => by simp [physHermite_one, map_ofNat] | n + 2, x => by rw [physHermite_succ_fun'] - have h1 := physHermite_parity (n + 1) x - have h2 := physHermite_parity n x - simp only [smul_neg, nsmul_eq_mul, cast_ofNat, h1, neg_mul, cast_add, cast_one, - add_tsub_cancel_right, h2, smul_eq_mul] + simp only [smul_neg, nsmul_eq_mul, cast_ofNat, physHermite_parity (n + 1) x, neg_mul, cast_add, + cast_one, add_tsub_cancel_right, physHermite_parity n x, smul_eq_mul] ring /-! @@ -239,29 +224,24 @@ lemma deriv_gaussian_eq_physHermite_mul_gaussian (n : ℕ) (x : ℝ) : (-1 : ℝ) ^ n * physHermite n x * Real.exp (- x ^ 2) := by rw [mul_assoc] induction' n with n ih generalizing x - · rw [Function.iterate_zero_apply, pow_zero, one_mul, physHermite_zero_apply, one_mul] + · simp · replace ih : deriv^[n] _ = _ := _root_.funext ih have deriv_gaussian : - deriv (fun y => Real.exp (-(y ^ 2))) x = -2 * x * Real.exp (-(x ^ 2)) := by - rw [deriv_exp (by simp)] - simp only [deriv.fun_neg', differentiableAt_fun_id, deriv_fun_pow, cast_ofNat, - Nat.add_one_sub_one, pow_one, deriv_id'', mul_one, mul_neg, neg_mul, neg_inj] - ring + deriv (fun y => Real.exp (-(y ^ 2))) x = -2 * x * Real.exp (-(x ^ 2)) := by + simp [mul_comm] rw [Function.iterate_succ_apply', ih, deriv_const_mul_field, deriv_fun_mul, pow_succ (-1 : ℝ), - deriv_gaussian, physHermite_succ] - · rw [derivative_physHermite,] - simp only [Polynomial.deriv_aeval, derivative_physHermite, nsmul_eq_mul, map_mul, + deriv_gaussian, physHermite_succ, derivative_physHermite] + · simp only [Polynomial.deriv_aeval, derivative_physHermite, nsmul_eq_mul, map_mul, map_natCast, map_sub, aeval_X, map_ofNat] ring - · exact Polynomial.differentiable_aeval .. - · simp [DifferentiableAt.exp] + · fun_prop + · fun_prop lemma physHermite_eq_deriv_gaussian (n : ℕ) (x : ℝ) : physHermite n x = (-1 : ℝ) ^ n * deriv^[n] (fun y => Real.exp (- y ^ 2)) x / Real.exp (- x ^ 2) := by rw [deriv_gaussian_eq_physHermite_mul_gaussian] - field_simp [Real.exp_ne_zero] - simp [← pow_mul] + simp [← mul_assoc, ← mul_pow, Real.exp_ne_zero] lemma physHermite_eq_deriv_gaussian' (n : ℕ) (x : ℝ) : physHermite n x = (-1 : ℝ) ^ n * deriv^[n] (fun y => Real.exp (- y ^ 2)) x * @@ -272,20 +252,15 @@ lemma physHermite_eq_deriv_gaussian' (n : ℕ) (x : ℝ) : @[fun_prop] lemma guassian_integrable_polynomial_cons {b c : ℝ} (hb : 0 < b) (P : Polynomial ℤ) : MeasureTheory.Integrable fun x : ℝ => (P.aeval (c * x)) * Real.exp (-b * x ^ 2) := by - conv => - enter [1, x] - rw [Polynomial.aeval_eq_sum_range, Finset.sum_mul] - apply MeasureTheory.integrable_finsetSum - intro i hi + simp_rw [Polynomial.aeval_eq_sum_range, Finset.sum_mul] + refine MeasureTheory.integrable_finsetSum _ fun i _ => ?_ have h2 : (fun a => P.coeff i • (c * a) ^ i * Real.exp (-b * a ^ 2)) = (c ^ i * P.coeff i : ℝ) • (fun x => (x ^ (i : ℝ) * Real.exp (-b * x ^ 2))) := by funext x simp only [neg_mul, mul_assoc, Real.rpow_natCast, Pi.smul_apply, smul_eq_mul] ring - refine h2 ▸ MeasureTheory.Integrable.smul (c ^ i * P.coeff i : ℝ) ?_ - apply integrable_rpow_mul_exp_neg_mul_sq (s := i) - · exact hb - · exact lt_of_le_of_lt' (Nat.cast_nonneg' i) neg_one_lt_zero + exact h2 ▸ MeasureTheory.Integrable.smul (c ^ i * P.coeff i : ℝ) + (integrable_rpow_mul_exp_neg_mul_sq hb (neg_one_lt_zero.trans_le (Nat.cast_nonneg' i))) @[fun_prop] lemma guassian_integrable_polynomial {b : ℝ} (hb : 0 < b) (P : Polynomial ℤ) : @@ -305,18 +280,16 @@ lemma physHermite_gaussian_integrable (n p m : ℕ) : simp only [Pi.mul_apply, deriv_gaussian_eq_physHermite_mul_gaussian, map_mul, Pi.smul_apply, smul_eq_mul, neg_one_mul] ring - rw [prod_eq_smul_aeval_mul_gaussian] - exact MeasureTheory.Integrable.smul _ (guassian_integrable_polynomial Real.zero_lt_one _) + exact prod_eq_smul_aeval_mul_gaussian ▸ + MeasureTheory.Integrable.smul _ (guassian_integrable_polynomial Real.zero_lt_one _) lemma integral_physHermite_mul_physHermite_eq_integral_deriv_exp (n m : ℕ) : ∫ x : ℝ, (physHermite n x * physHermite m x) * Real.exp (-x ^ 2) = (-1 : ℝ) ^ m * ∫ x : ℝ, (physHermite n x * (deriv^[m] fun x => Real.exp (-x ^ 2)) x) := by have h1 (x : ℝ) : (physHermite n x * physHermite m x) * Real.exp (-x ^ 2) = (-1 : ℝ) ^ m * (physHermite n x * (deriv^[m] fun x => Real.exp (-x ^ 2)) x) := by - conv_lhs => - enter [1, 2] - rw [physHermite_eq_deriv_gaussian'] - rw [mul_assoc, mul_assoc, ← Real.exp_add, add_neg_cancel, Real.exp_zero, mul_one] + rw [physHermite_eq_deriv_gaussian' m x, mul_assoc, mul_assoc, ← Real.exp_add, add_neg_cancel, + Real.exp_zero, mul_one] ring simp only [h1, MeasureTheory.integral_const_mul] @@ -325,15 +298,11 @@ lemma integral_physHermite_mul_physHermite_eq_integral_deriv_inductive (n m : ∫ x : ℝ, (physHermite n x * physHermite m x) * Real.exp (- x ^ 2) = (-1 : ℝ) ^ (m - p) * ∫ x : ℝ, (deriv^[p] (physHermite n) x * (deriv^[m - p] fun x => Real.exp (-x ^ 2)) x) - | 0, h => by - exact integral_physHermite_mul_physHermite_eq_integral_deriv_exp n m + | 0, h => integral_physHermite_mul_physHermite_eq_integral_deriv_exp n m | p + 1, h => by - rw [integral_physHermite_mul_physHermite_eq_integral_deriv_inductive n m p (by omega)] - have h1 : m - p = m - (p + 1) + 1 := by omega - rw [h1, Function.iterate_succ_apply'] - conv_rhs => rw [Function.iterate_succ_apply'] - have h1 : (-1 : ℝ) ^ (m - (p + 1) + 1) = (-1) ^ (m - (p + 1)) * (-1) := by simp [pow_add] - rw [h1, mul_assoc] + rw [integral_physHermite_mul_physHermite_eq_integral_deriv_inductive n m p (by omega), + show m - p = m - (p + 1) + 1 by omega, Function.iterate_succ_apply', pow_succ, mul_assoc, + Function.iterate_succ_apply'] congr have hl : ∫ (x : ℝ), deriv^[p] (physHermite n) x * deriv (deriv^[m - (p + 1)] fun x => Real.exp (-x ^ 2)) x = @@ -342,12 +311,11 @@ lemma integral_physHermite_mul_physHermite_eq_integral_deriv_inductive (n m : apply MeasureTheory.integral_mul_deriv_eq_deriv_mul_of_integrable · exact fun _ _ ↦ DifferentiableAt.hasDerivAt (deriv_physHermite_differentiableAt n p _) · intro x - simp only [hasDerivAt_deriv_iff] + rw [hasDerivAt_deriv_iff] have h1 : (deriv^[m - (p + 1)] fun x => Real.exp (-x ^ 2)) = fun x => (-1 : ℝ) ^ (m - (p + 1)) * physHermite (m - (p + 1)) x * - Real.exp (- x ^ 2) := by - funext x - exact deriv_gaussian_eq_physHermite_mul_gaussian (m - (p + 1)) x + Real.exp (- x ^ 2) := funext fun x => + deriv_gaussian_eq_physHermite_mul_gaussian (m - (p + 1)) x rw [h1] fun_prop · rw [← Function.iterate_succ_apply' deriv] @@ -360,7 +328,7 @@ lemma integral_physHermite_mul_physHermite_eq_integral_deriv_inductive (n m : lemma integral_physHermite_mul_physHermite_eq_integral_deriv (n m : ℕ) : ∫ x : ℝ, (physHermite n x * physHermite m x) * Real.exp (- x ^ 2) = ∫ x : ℝ, (deriv^[m] (physHermite n) x * (Real.exp (-x ^ 2))) := by - simp [integral_physHermite_mul_physHermite_eq_integral_deriv_inductive n m m (by rfl)] + simp [integral_physHermite_mul_physHermite_eq_integral_deriv_inductive n m m le_rfl] lemma physHermite_orthogonal_lt {n m : ℕ} (hnm : n < m) : ∫ x : ℝ, (physHermite n x * physHermite m x) * Real.exp (- x ^ 2) = 0 := by @@ -369,54 +337,32 @@ lemma physHermite_orthogonal_lt {n m : ℕ} (hnm : n < m) : theorem physHermite_orthogonal {n m : ℕ} (hnm : n ≠ m) : ∫ x : ℝ, (physHermite n x * physHermite m x) * Real.exp (- x ^ 2) = 0 := by - by_cases hnm' : n < m - · exact physHermite_orthogonal_lt hnm' - · have hmn : m < n := by omega - conv_lhs => - enter [2, x, 1] - rw [mul_comm] - rw [physHermite_orthogonal_lt hmn] + obtain h | h := hnm.lt_or_gt + · exact physHermite_orthogonal_lt h + · simpa [mul_comm] using physHermite_orthogonal_lt h lemma physHermite_orthogonal_cons {n m : ℕ} (hnm : n ≠ m) (c : ℝ) : ∫ x : ℝ, (physHermite n (c * x) * physHermite m (c * x)) * Real.exp (- c ^ 2 * x ^ 2) = 0 := by - trans ∫ x : ℝ, (fun x => (physHermite n x * physHermite m x) * Real.exp (- x^2)) (c * x) - · congr - funext x - simp only [neg_mul, mul_eq_mul_left_iff, Real.exp_eq_exp, neg_inj, _root_.mul_eq_zero] - left - exact Eq.symm (mul_pow c x 2) - rw [MeasureTheory.Measure.integral_comp_mul_left - (fun x => physHermite n x * physHermite m x * Real.exp (-x ^ 2)) c] - rw [physHermite_orthogonal hnm] - simp + have h := MeasureTheory.Measure.integral_comp_mul_left + (fun x => physHermite n x * physHermite m x * Real.exp (-x ^ 2)) c + rw [physHermite_orthogonal hnm, smul_zero] at h + simpa [mul_pow, neg_mul] using h theorem physHermite_norm (n : ℕ) : ∫ x : ℝ, (physHermite n x * physHermite n x) * Real.exp (- x ^ 2) = ↑n ! * 2 ^ n * √Real.pi := by rw [integral_physHermite_mul_physHermite_eq_integral_deriv, iterated_deriv_physHermite_eq_aeval] - simp only [iterate_derivative_physHermite_self] - conv_lhs => - enter [2, x] - rw [aeval_C] - simp - rw [MeasureTheory.integral_const_mul] - have h1 : ∫ (x : ℝ), Real.exp (- x^2) = Real.sqrt (Real.pi) := by - simpa using integral_gaussian 1 - rw [h1] + simp [MeasureTheory.integral_const_mul, map_ofNat, + show (∫ x : ℝ, Real.exp (-x ^ 2)) = √Real.pi by simpa using integral_gaussian 1] lemma physHermite_norm_cons (n : ℕ) (c : ℝ) : ∫ x : ℝ, (physHermite n (c * x) * physHermite n (c * x)) * Real.exp (- c ^ 2 * x ^ 2) = |c⁻¹| • (↑n ! * 2 ^ n * √Real.pi) := by - trans ∫ x : ℝ, (fun x => (physHermite n x * physHermite n x) * Real.exp (- x^2)) (c * x) - · congr - funext x - simp only [neg_mul, mul_eq_mul_left_iff, Real.exp_eq_exp, neg_inj, _root_.mul_eq_zero, or_self] - left - exact Eq.symm (mul_pow c x 2) - rw [MeasureTheory.Measure.integral_comp_mul_left - (fun x => physHermite n x * physHermite n x * Real.exp (-x ^ 2)) c] - rw [physHermite_norm] + have h := MeasureTheory.Measure.integral_comp_mul_left + (fun x => physHermite n x * physHermite n x * Real.exp (-x ^ 2)) c + rw [physHermite_norm] at h + simpa [mul_pow, neg_mul] using h set_option backward.isDefEq.respectTransparency false in lemma polynomial_mem_physHermite_span_induction (P : Polynomial ℤ) : (n : ℕ) → @@ -429,18 +375,14 @@ lemma polynomial_mem_physHermite_span_induction (P : Polynomial ℤ) : (n : ℕ) simp | n + 1, h => by by_cases hP0 : P = 0 - · subst hP0 - simp only [map_zero] - exact Submodule.zero_mem _ + · simp [hP0, ← Pi.zero_def] let P' := ((coeff (physHermite (n + 1)) (n + 1)) • P - (coeff P (n + 1)) • physHermite (n + 1)) have hP'mem : (fun x => P'.aeval x) ∈ Submodule.span ℝ (Set.range (fun n => (physHermite n : ℝ → ℝ))) := by by_cases hP' : P' = 0 - · rw [hP'] - simp only [map_zero] - exact Submodule.zero_mem _ - · exact polynomial_mem_physHermite_span_induction P' P'.natDegree (by rfl) + · simp [hP', ← Pi.zero_def] + · exact polynomial_mem_physHermite_span_induction P' P'.natDegree rfl simp only [P'] at hP'mem have hl : (fun x => (aeval x) ((physHermite (n + 1)).coeff (n + 1) • P - P.coeff (n + 1) • physHermite (n + 1))) @@ -448,12 +390,10 @@ lemma polynomial_mem_physHermite_span_induction (P : Polynomial ℤ) : (n : ℕ) (fun (x : ℝ)=> (aeval x) (physHermite (n + 1))) := by funext x simp [coeff_physHermite_self_succ, map_ofNat] - rw [hl] at hP'mem - rw [Submodule.sub_mem_iff_left] at hP'mem - · rw [Submodule.smul_mem_iff] at hP'mem - · exact hP'mem - · simp - exact Submodule.smul_mem _ _ (Submodule.subset_span ⟨n + 1, rfl⟩) + rw [hl, Submodule.sub_mem_iff_left] at hP'mem + · rwa [Submodule.smul_mem_iff] at hP'mem + simp + · exact Submodule.smul_mem _ _ (Submodule.subset_span ⟨n + 1, rfl⟩) decreasing_by rw [Polynomial.natDegree_lt_iff_degree_lt] · apply (Polynomial.degree_lt_iff_coeff_zero _ _).mpr @@ -476,30 +416,21 @@ lemma polynomial_mem_physHermite_span (P : Polynomial ℤ) : lemma cos_mem_physHermite_span_topologicalClosure (c : ℝ) : (fun (x : ℝ) => Real.cos (c * x)) ∈ (Submodule.span ℝ (Set.range (fun n => (physHermite n : ℝ → ℝ)))).topologicalClosure := by - change (fun (x : ℝ) => Real.cos (c * x)) ∈ - closure (Submodule.span ℝ (Set.range (fun n => (physHermite n : ℝ → ℝ)))) - have h1 := Real.hasSum_cos - simp only [HasSum] at h1 have h1 : Filter.Tendsto (fun s => fun y => ∑ x ∈ s, (-1) ^ x * (c * y) ^ (2 * x) / ((2 * x)! : ℝ)) - Filter.atTop (nhds (fun x => Real.cos (c * x))) := by - exact tendsto_pi_nhds.mpr fun x => h1 (c * x) + Filter.atTop (nhds (fun x => Real.cos (c * x))) := + tendsto_pi_nhds.mpr fun x => Real.hasSum_cos (c * x) have h2 (z : Finset ℕ) : (fun y => ∑ x ∈ z, (-1) ^ x * (c * y) ^ (2 * x) / ↑(2 * x)!) ∈ ↑(Submodule.span ℝ (Set.range (fun n => (physHermite n : ℝ → ℝ)))) := by have h0 : (fun y => ∑ x ∈ z, (-1) ^ x * (c * y) ^ (2 * x) / ↑(2 * x)!) = ∑ x ∈ z, (((-1) ^ x * c ^ (2 * x) / ↑(2 * x)!) • fun (y : ℝ) => (y) ^ (2 * x)) := by funext y simp only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul] - congr - funext z - ring + exact Finset.sum_congr rfl fun i _ => by ring rw [h0] - apply Submodule.sum_mem - intro l hl - apply Submodule.smul_mem - have hy : (fun (y : ℝ) => y ^ (2 * l)) = fun y => ((X ^ (2 * l) : Polynomial ℤ)).aeval y := by - funext y - simp + refine Submodule.sum_mem _ fun l _ => Submodule.smul_mem _ _ ?_ + have hy : (fun (y : ℝ) => y ^ (2 * l)) = fun y => ((X ^ (2 * l) : Polynomial ℤ)).aeval y := + funext fun y => by simp exact hy ▸ polynomial_mem_physHermite_span _ exact mem_closure_of_tendsto h1 (Filter.Eventually.of_forall h2) diff --git a/Physlib/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean b/Physlib/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean index 0bcaef70b..c6d68cf47 100644 --- a/Physlib/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean +++ b/Physlib/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean @@ -56,14 +56,8 @@ namespace HasVarAdjDerivAt variable {μ : Measure X} lemma apply_smooth_of_smooth {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} {u v : X → U} - (h : HasVarAdjDerivAt F F' u) (hv : ContDiff ℝ ∞ v) : ContDiff ℝ ∞ (F v) := by - have h1 := h.diff (fun _ => v) (by fun_prop) - have hf : F v = (fun (sx : ℝ × X) => F v sx.2) ∘ fun x => (0, x) := by - funext x - simp - rw [hf] - apply ContDiff.comp h1 - fun_prop + (h : HasVarAdjDerivAt F F' u) (hv : ContDiff ℝ ∞ v) : ContDiff ℝ ∞ (F v) := + (h.diff (fun _ => v) (by fun_prop)).comp (f := fun x : X => ((0 : ℝ), x)) (by fun_prop) lemma apply_smooth_self {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} {u : X → U} (h : HasVarAdjDerivAt F F' u) : ContDiff ℝ ∞ (F u) := by @@ -83,21 +77,13 @@ lemma smooth_linear {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} lemma smooth_adjoint {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} {u : X → U} (h : HasVarAdjDerivAt F F' u) {δu : X → U} (h' : ContDiff ℝ ∞ δu) (x : X) : ContDiff (E:= ℝ) (F := V) ℝ ∞ ((fun s : ℝ => F (fun x' => u x' + s • δu x') x)) := by - have h1 : ((fun s : ℝ => F (fun x' => u x' + s • δu x') x)) - = (fun sx : ℝ × X => F ((fun r x' => u x' + r • δu x') sx.1) sx.2) ∘ (·, x) := by - funext x - simp - rw [h1] - apply ContDiff.comp - · apply h.diff (φ := (fun r x' => u x' + r • δu x')) - have hx := h.smooth_at - fun_prop - · fun_prop + have hx := h.smooth_at + exact (h.diff (fun r x' => u x' + r • δu x') (by fun_prop)).comp (f := (·, x)) (by fun_prop) lemma differentiable_linear {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} {u : X → U} (h : HasVarAdjDerivAt F F' u) {φ : ℝ → X → U} (hφ : ContDiff ℝ ∞ ↿φ) (x : X) : - Differentiable ℝ (fun s' : ℝ => F (fun x => φ 0 x + s' • deriv (φ · x) 0) x) := by - exact fun x => (h.smooth_linear hφ).differentiable (by simp) x + Differentiable ℝ (fun s' : ℝ => F (fun x => φ 0 x + s' • deriv (φ · x) 0) x) := + (h.smooth_linear hφ).differentiable (by simp) omit [MeasureSpace X] [InnerProductSpace' ℝ U] [InnerProductSpace' ℝ V] in lemma linearize_of_linear {F : (X → U) → (X → V)} @@ -174,9 +160,9 @@ lemma hasVarAdjDerivAt_of_hasVarAdjoint_of_linear lemma id (u) (hu : ContDiff ℝ ∞ u) : HasVarAdjDerivAt (fun φ : X → U => φ) (fun ψ => ψ) u where smooth_at := hu - diff := by intros; fun_prop + diff := fun _ h => h linearize := by intro φ hφ x; simp [deriv_smul_const] - adjoint := by simp [deriv_smul_const]; apply HasVarAdjoint.id + adjoint := by simpa [deriv_smul_const] using HasVarAdjoint.id lemma const (u : X → U) (v : X → V) (hu : ContDiff ℝ ∞ u) (hv : ContDiff ℝ ∞ v) : HasVarAdjDerivAt (fun _ : X → U => v) (fun _ => 0) u where @@ -314,7 +300,7 @@ lemma fst {F : (X → U) → (X → W×V)} (fun φ x => (F φ x).1) (fun φ x => F' (fun x' => (φ x', 0)) x) u where smooth_at := hF.smooth_at - diff := fun φ _ => ContDiff.comp contDiff_fst (hF.diff φ (by fun_prop)) + diff := fun φ _ => contDiff_fst.comp (hF.diff φ (by fun_prop)) linearize := by intro φ hφ x have h1 := hF.linearize φ hφ x @@ -326,9 +312,9 @@ lemma fst {F : (X → U) → (X → W×V)} rw [← fderiv_apply_one_eq_deriv] rw [fderiv_fun_comp _ (by fun_prop)] simp [fderiv_fst] - · apply ContDiff.differentiable (n := ∞) (hF.smooth_linear hφ) (by simp) + · apply (hF.smooth_linear hφ).differentiable (by simp) · fun_prop - · apply ContDiff.differentiable (n := ∞) (hF.smooth_R hφ x) (by simp) + · apply (hF.smooth_R hφ x).differentiable (by simp) adjoint := by apply HasVarAdjoint.congr_fun (G := (fun δu x => (deriv (fun s => (F (fun x' => u x' + s • δu x') x)) (0 :ℝ)).1)) @@ -347,7 +333,7 @@ lemma snd {F : (X → U) → (X → W×V)} (fun φ x => (F φ x).2) (fun φ x => F' (fun x' => (0, φ x')) x) u where smooth_at := hF.smooth_at - diff := fun φ _ => ContDiff.comp contDiff_snd (hF.diff φ (by fun_prop)) + diff := fun φ _ => contDiff_snd.comp (hF.diff φ (by fun_prop)) linearize := by intro φ hφ x have h1 := hF.linearize φ hφ x @@ -359,9 +345,9 @@ lemma snd {F : (X → U) → (X → W×V)} rw [← fderiv_apply_one_eq_deriv] rw [fderiv_fun_comp _ (by fun_prop)] simp [fderiv_snd] - · apply ContDiff.differentiable (n := ∞) (hF.smooth_linear hφ) (by simp) + · apply (hF.smooth_linear hφ).differentiable (by simp) · fun_prop - · apply ContDiff.differentiable (n := ∞) (hF.smooth_R hφ x) (by simp) + · apply (hF.smooth_R hφ x).differentiable (by simp) adjoint := by apply HasVarAdjoint.congr_fun (G := (fun δu x => (deriv (fun s => (F (fun x' => u x' + s • δu x') x)) (0 :ℝ)).2)) @@ -500,13 +486,11 @@ lemma fmap lemma neg (F : (X → U) → (X → V)) (F') (u) (hF : HasVarAdjDerivAt F F' u) : HasVarAdjDerivAt (fun φ x => -F φ x) (fun ψ x => - F' ψ x) u where smooth_at := hF.smooth_at - diff := by intro φ hφ; apply ContDiff.neg; apply hF.diff; assumption + diff := fun φ hφ => (hF.diff φ hφ).neg linearize := by - intros - rw[deriv.fun_neg] + intro φ hφ x simp only [deriv.fun_neg, neg_inj] - rw[hF.linearize] - assumption + exact hF.linearize φ hφ x adjoint := by apply HasVarAdjoint.congr_fun case h' => @@ -517,9 +501,7 @@ lemma neg (F : (X → U) → (X → V)) (F') (u) (hF : HasVarAdjDerivAt F F' u) rw[deriv.fun_neg] simp [hF.linearize (fun s x' => u x' + s • φ x') (by fun_prop)] simp[deriv_smul_const] - case h => - apply HasVarAdjoint.neg - apply hF.adjoint + case h => exact HasVarAdjoint.neg hF.adjoint section OnFiniteMeasures @@ -530,11 +512,7 @@ lemma add (hF : HasVarAdjDerivAt F F' u) (hG : HasVarAdjDerivAt G G' u) : HasVarAdjDerivAt (fun φ x => F φ x + G φ x) (fun ψ x => F' ψ x + G' ψ x) u where smooth_at := hF.smooth_at - diff := by - intro φ hφ - apply ContDiff.add - · apply hF.diff; assumption - · apply hG.diff; assumption + diff := fun φ hφ => (hF.diff φ hφ).add (hG.diff φ hφ) linearize := by intro φ hφ x; rw[deriv_fun_add]; rw[deriv_fun_add]; rw[hF.linearize _ hφ, hG.linearize _ hφ] · exact hF.differentiable_linear hφ x 0 @@ -547,21 +525,16 @@ lemma add intro φ hφ; funext x have := hφ.smooth; have := hF.smooth_at have h1 : DifferentiableAt ℝ (fun s => F (fun x' => u x' + s • φ x') x) (0 : ℝ) := - (hF.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable (by simp) 0 + (hF.smooth_adjoint hφ.contDiff x).differentiable (by simp) 0 have h2 : DifferentiableAt ℝ (fun s => G (fun x' => u x' + s • φ x') x) (0 : ℝ) := - (hG.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable (by simp) 0 + (hG.smooth_adjoint hφ.contDiff x).differentiable (by simp) 0 conv => lhs rw[deriv_fun_add h1 h2] simp [hF.linearize (fun s x' => u x' + s • φ x') (by fun_prop)] simp [hG.linearize (fun s x' => u x' + s • φ x') (by fun_prop)] simp[deriv_smul_const] - case h => - apply HasVarAdjoint.add - apply hF.adjoint - apply hG.adjoint + case h => exact HasVarAdjoint.add hF.adjoint hG.adjoint lemma sum {ι : Type} [Fintype ι] (F : ι → (X → U) → (X → V)) (F' : ι → (X → V) → X → U) (u) @@ -582,9 +555,7 @@ lemma sum {ι : Type} [Fintype ι] rw [← @e.sum_comp] · intro i ι' u hu ih simp only [Finset.univ_eq_empty, Finset.sum_empty] - apply HasVarAdjDerivAt.const - fun_prop - fun_prop + apply HasVarAdjDerivAt.const <;> fun_prop · intro i ι' hp F F' u hu ih simp only [Fintype.sum_option] apply HasVarAdjDerivAt.add @@ -598,11 +569,7 @@ lemma mul HasVarAdjDerivAt (fun φ x => F φ x * G φ x) (fun ψ x => F' (fun x' => ψ x' * G u x') x + G' (fun x' => F u x' * ψ x') x) u where smooth_at := hF.smooth_at - diff := by - intro φ hφ - apply ContDiff.mul - · apply hF.diff; assumption - · apply hG.diff; assumption + diff := fun φ hφ => (hF.diff φ hφ).mul (hG.diff φ hφ) linearize := by intro φ hφ x rw [deriv_fun_mul, deriv_fun_mul] @@ -619,11 +586,9 @@ lemma mul have := hφ.smooth; have := hF.smooth_at -- Same two results as the `add` case have h1 : DifferentiableAt ℝ (fun s => F (fun x' => u x' + s • φ x') x) (0 : ℝ) := - (hF.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable (by simp) 0 + (hF.smooth_adjoint hφ.contDiff x).differentiable (by simp) 0 have h2 : DifferentiableAt ℝ (fun s => G (fun x' => u x' + s • φ x') x) (0 : ℝ) := - (hG.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable (by simp) 0 + (hG.smooth_adjoint hφ.contDiff x).differentiable (by simp) 0 conv => lhs rw[deriv_fun_mul h1 h2] @@ -709,8 +674,7 @@ protected lemma gradient {d} (u : Space d → ℝ) (hu : ContDiff ℝ ∞ u) : simp [Space.gradient_eq_sum] apply ContDiff.sum intro i _ - simp only [Space.deriv] - fun_prop + fun_prop [Space.deriv] · intro φ1 φ2 h1 h2 rw [Space.gradient_eq_grad] rw [Space.grad_add, Space.grad_eq_gradient, Space.grad_eq_gradient] @@ -760,8 +724,7 @@ protected lemma grad {d} (u : Space d → ℝ) (hu : ContDiff ℝ ∞ u) : simp [Space.grad_eq_sum] apply ContDiff.sum intro i _ - simp only [Space.deriv] - fun_prop + fun_prop [Space.deriv] · intro φ1 φ2 h1 h2 rw [Space.grad_add] · exact h1.differentiable (by simp) @@ -804,8 +767,7 @@ lemma div {d} (u : Space d → EuclideanSpace ℝ (Fin d)) (hu : ContDiff ℝ simp [Space.div] apply ContDiff.sum intro i _ - simp_rw [Space.deriv] - fun_prop + fun_prop [Space.deriv] · intro φ1 φ2 h1 h2 apply Space.div_add · exact h1.differentiable (by simp) diff --git a/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean b/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean index dabe8bf76..a45c2e2aa 100644 --- a/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean +++ b/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean @@ -92,8 +92,8 @@ lemma comp {F : (Y → V) → (Z → W)} {G : (X → U) → (Y → V)} {F' G'} test_fun_preserving _ hφ := hF.test_fun_preserving _ (hG.test_fun_preserving _ hφ) test_fun_preserving' _ hφ := hG.test_fun_preserving' _ (hF.test_fun_preserving' _ hφ) adjoint φ ψ hφ hψ := by - rw [hF.adjoint _ _ (hG.test_fun_preserving φ hφ) hψ] - rw [hG.adjoint _ _ hφ (hF.test_fun_preserving' _ hψ)] + rw [hF.adjoint _ _ (hG.test_fun_preserving φ hφ) hψ, + hG.adjoint _ _ hφ (hF.test_fun_preserving' _ hψ)] ext' := IsLocalizedFunctionTransform.fun_comp hG.ext' hF.ext' lemma congr_fun {F G : (X → U) → (Y → V)} {F' : (Y → V) → (X → U)} @@ -133,10 +133,7 @@ lemma unique_on_test_functions {F : (X → U) → (Y → V)} {F' G' : (Y → V) rw [← sub_eq_iff_eq_add] change (F' - G') φ = 0 apply fundamental_theorem_of_variational_calculus (@volume X _) - · simp - apply IsTestFunction.sub - · exact F'_preserve_test φ hφ - · exact G'_preserve_test φ hφ + · exact (F'_preserve_test φ hφ).sub (G'_preserve_test φ hφ) · intro ψ hψ simp [inner_sub_left'] rw [MeasureTheory.integral_sub] @@ -147,14 +144,8 @@ lemma unique_on_test_functions {F : (X → U) → (Y → V)} {F' G' : (Y → V) enter [1, 2, a] rw [← inner_conj_symm'] simp[← F'_adjoint ψ φ hψ hφ,G'_adjoint ψ φ hψ hφ] - · apply IsTestFunction.integrable - apply IsTestFunction.inner - · exact F'_preserve_test φ hφ - · exact hψ - · apply IsTestFunction.integrable - apply IsTestFunction.inner - · exact G'_preserve_test φ hφ - · exact hψ + · exact ((F'_preserve_test φ hφ).inner hψ).integrable _ + · exact ((G'_preserve_test φ hφ).inner hψ).integrable _ /-- Variational adjoint is unique only when applied to smooth functions. -/ lemma unique @@ -206,25 +197,17 @@ lemma unique lemma neg {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} (hF : HasVarAdjoint F F') : HasVarAdjoint (fun φ x => - F φ x) (fun φ x => - F' φ x) where - test_fun_preserving _ hφ := by - have := hF.test_fun_preserving _ hφ - fun_prop - test_fun_preserving' _ hφ := by - have := hF.test_fun_preserving' _ hφ - fun_prop - adjoint _ _ _ _ := by - simp [integral_neg] - rw[hF.adjoint _ _ (by assumption) (by assumption)] + test_fun_preserving _ hφ := (hF.test_fun_preserving _ hφ).neg + test_fun_preserving' _ hφ := (hF.test_fun_preserving' _ hφ).neg + adjoint φ ψ hφ hψ := by + simpa [integral_neg] using hF.adjoint _ _ hφ hψ ext' := IsLocalizedFunctionTransform.neg hF.ext' -- ext := IsLocalizedFunctionTransform.neg hF.ext lemma of_neg {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} (hF : HasVarAdjoint (fun φ x => - F φ x) (fun φ x => - F' φ x)) : HasVarAdjoint F F' := by - have hF : F = (fun φ x => - - F φ x) := by simp - have hF' : F' = (fun φ x => - - F' φ x) := by simp - rw [hF, hF'] - (expose_names; exact neg hF_1) + simpa using neg hF section OnFiniteMeasures @@ -235,36 +218,19 @@ variable lemma add {F G : (X → U) → (X → V)} {F' G' : (X → V) → (X → U)} (hF : HasVarAdjoint F F') (hG : HasVarAdjoint G G') : HasVarAdjoint (fun φ x => F φ x + G φ x) (fun φ x => F' φ x + G' φ x) where - test_fun_preserving _ hφ := by - have := hF.test_fun_preserving _ hφ - have := hG.test_fun_preserving _ hφ - fun_prop - test_fun_preserving' _ hφ := by - have := hF.test_fun_preserving' _ hφ - have := hG.test_fun_preserving' _ hφ - fun_prop - adjoint _ _ _ _ := by - simp[inner_add_left',inner_add_right'] - rw[MeasureTheory.integral_add] - rw[MeasureTheory.integral_add] - rw[hF.adjoint _ _ (by assumption) (by assumption)] - rw[hG.adjoint _ _ (by assumption) (by assumption)] - · apply IsTestFunction.integrable - apply IsTestFunction.inner - · (expose_names; exact h) - · (expose_names; exact hF.test_fun_preserving' x_1 h_1) - · apply IsTestFunction.integrable - apply IsTestFunction.inner - · (expose_names; exact h) - · (expose_names; exact hG.test_fun_preserving' x_1 h_1) - · apply IsTestFunction.integrable - apply IsTestFunction.inner - · (expose_names; exact hF.test_fun_preserving x h) - · (expose_names; exact h_1) - · apply IsTestFunction.integrable - apply IsTestFunction.inner - · (expose_names; exact hG.test_fun_preserving x h) - · (expose_names; exact h_1) + test_fun_preserving _ hφ := + (hF.test_fun_preserving _ hφ).add (hG.test_fun_preserving _ hφ) + test_fun_preserving' _ hφ := + (hF.test_fun_preserving' _ hφ).add (hG.test_fun_preserving' _ hφ) + adjoint φ ψ hφ hψ := by + have hFφ := hF.test_fun_preserving φ hφ + have hGφ := hG.test_fun_preserving φ hφ + have hFψ := hF.test_fun_preserving' ψ hψ + have hGψ := hG.test_fun_preserving' ψ hψ + simp only [inner_add_left', inner_add_right'] + rw [integral_add ((hFφ.inner hψ).integrable _) ((hGφ.inner hψ).integrable _), + integral_add ((hφ.inner hFψ).integrable _) ((hφ.inner hGψ).integrable _), + hF.adjoint _ _ hφ hψ, hG.adjoint _ _ hφ hψ] ext' := IsLocalizedFunctionTransform.add hF.ext' hG.ext' -- ext := IsLocalizedFunctionTransform.add hF.ext hG.ext @@ -294,27 +260,20 @@ lemma sum {ι : Type} [Fintype ι] {F : ι → (X → U) → (X → V)} {F' : ι lemma sub {F G : (X → U) → (X → V)} {F' G' : (X → V) → (X → U)} (hF : HasVarAdjoint F F') (hG : HasVarAdjoint G G') : HasVarAdjoint (fun φ x => F φ x - G φ x) (fun φ x => F' φ x - G' φ x) := by - simp [sub_eq_add_neg] - apply add hF (neg hG) + simpa [sub_eq_add_neg] using add hF (neg hG) end OnFiniteMeasures lemma mul_left {F : (X → U) → (X → ℝ)} {ψ : X → ℝ} {F' : (X → ℝ) → (X → U)} (hF : HasVarAdjoint F F') (hψ : ContDiff ℝ ∞ ψ) : HasVarAdjoint (fun φ x => ψ x * F φ x) (fun φ x => F' (fun x => ψ x * φ x) x) where - test_fun_preserving φ hφ := by - have := hF.test_fun_preserving _ hφ - fun_prop - test_fun_preserving' φ hφ := by - apply hF.test_fun_preserving' - fun_prop + test_fun_preserving φ hφ := IsTestFunction.mul_left hψ (hF.test_fun_preserving _ hφ) + test_fun_preserving' φ hφ := hF.test_fun_preserving' _ (IsTestFunction.mul_left hψ hφ) adjoint φ ψ' hφ hψ' := by rw [← hF.adjoint] · congr; funext x; simp; ring · exact hφ - · apply IsTestFunction.mul_left - · exact hψ - · exact hψ' + · exact IsTestFunction.mul_left hψ hψ' ext' := by intro K cK obtain ⟨L,cL,h⟩ := hF.ext' K cK @@ -324,19 +283,13 @@ lemma mul_left {F : (X → U) → (X → ℝ)} {ψ : X → ℝ} {F' : (X → ℝ lemma mul_right {F : (X → U) → (X → ℝ)} {ψ : X → ℝ} {F' : (X → ℝ) → (X → U)} (hF : HasVarAdjoint F F') (hψ : ContDiff ℝ ∞ ψ) : HasVarAdjoint (fun φ x => F φ x * ψ x) (fun φ x => F' (fun x => φ x * ψ x) x) where - test_fun_preserving φ hφ := by - have := hF.test_fun_preserving _ hφ - fun_prop - test_fun_preserving' φ hφ := by - apply hF.test_fun_preserving' - fun_prop + test_fun_preserving φ hφ := IsTestFunction.mul_right (hF.test_fun_preserving _ hφ) hψ + test_fun_preserving' φ hφ := hF.test_fun_preserving' _ (IsTestFunction.mul_right hφ hψ) adjoint φ ψ' hφ hψ' := by rw [← hF.adjoint] · congr; funext x; simp; ring · exact hφ - · apply IsTestFunction.mul_right - · exact hψ' - · exact hψ + · exact IsTestFunction.mul_right hψ' hψ ext' := by intro K cK obtain ⟨L,cL,h⟩ := hF.ext' K cK @@ -346,12 +299,8 @@ lemma mul_right {F : (X → U) → (X → ℝ)} {ψ : X → ℝ} {F' : (X → lemma smul_left {F : (X → U) → (X → V)} {ψ : X → ℝ} {F' : (X → V) → (X → U)} (hF : HasVarAdjoint F F') (hψ : ContDiff ℝ ∞ ψ) : HasVarAdjoint (fun φ x => ψ x • F φ x) (fun φ x => F' (fun x' => ψ x' • φ x') x) where - test_fun_preserving φ hφ := by - have := hF.test_fun_preserving φ hφ - fun_prop - test_fun_preserving' φ hφ := by - apply hF.test_fun_preserving' _ _ - fun_prop + test_fun_preserving φ hφ := IsTestFunction.smul_left hψ (hF.test_fun_preserving φ hφ) + test_fun_preserving' φ hφ := hF.test_fun_preserving' _ (IsTestFunction.smul_left hψ hφ) adjoint φ ψ hφ hψ := by simp_rw[inner_smul_left', ← inner_smul_right'] rw [hF.adjoint] @@ -439,9 +388,7 @@ protected lemma deriv : exact (hφ.differentiable x).inner' (hψ.differentiable x) · fun_prop · apply IsTestFunction.integrable (hφ.inner hψ) - ext' := by - apply IsLocalizedFunctionTransform.neg - apply IsLocalizedFunctionTransform.deriv + ext' := IsLocalizedFunctionTransform.neg IsLocalizedFunctionTransform.deriv -- ext := IsLocalizedFunctionTransform.deriv lemma fderiv_apply {dx} @@ -450,9 +397,7 @@ lemma fderiv_apply {dx} HasVarAdjoint (fun φ : X → U => (fderiv ℝ φ · dx)) (fun φ x => - fderiv ℝ φ x dx) where test_fun_preserving φ hφ := by fun_prop test_fun_preserving' φ hφ := by fun_prop - ext' := by - apply IsLocalizedFunctionTransform.neg - apply IsLocalizedFunctionTransform.fderiv + ext' := IsLocalizedFunctionTransform.neg IsLocalizedFunctionTransform.fderiv adjoint φ ψ hφ hψ := by rw [← sub_eq_zero] rw [← integral_sub] @@ -609,9 +554,7 @@ protected lemma gradient {d} : rw [divergence_eq_space_div] simp only [smul_eq_mul, mul_one] exact hφ.differentiable - · apply IsLocalizedFunctionTransform.neg - - apply IsLocalizedFunctionTransform.div_comp_repr + · exact IsLocalizedFunctionTransform.neg IsLocalizedFunctionTransform.div_comp_repr · intro φ hφ funext x rw [gradient_eq_adjFDeriv] @@ -624,9 +567,7 @@ lemma grad {d} : HasVarAdjoint (fun (φ : Space d → ℝ) x => Space.grad φ x) have h1 := clm_apply f (by fun_prop) simp [f] at h1 have hx : (_root_.adjoint ℝ (⇑Space.basis.repr)) = (Space.basis (d := d)).repr.symm := by - refine HasAdjoint.adjoint ?_ - refine { adjoint_inner_left := ?_ } - intro x y + refine HasAdjoint.adjoint ⟨fun x y => ?_⟩ rw [real_inner_comm, ← Space.basis_repr_inner_eq, real_inner_comm] simp [hx] at h1 have h2 := HasVarAdjoint.comp h1 (HasVarAdjoint.gradient (d := d)) @@ -652,14 +593,11 @@ lemma prod HasVarAdjoint (fun φ x => (F φ x, G φ x)) (fun φ x => F' (fun x' => (φ x').1) x + G' (fun x' => (φ x').2) x) where - test_fun_preserving _ hφ := by - have := hF.test_fun_preserving _ hφ - have := hG.test_fun_preserving _ hφ - fun_prop - test_fun_preserving' y hφ := by - have := hF.test_fun_preserving' (fun x => (y x).1) (by fun_prop) - have := hG.test_fun_preserving' (fun x => (y x).2) (by fun_prop) - fun_prop + test_fun_preserving _ hφ := + IsTestFunction.prodMk (hF.test_fun_preserving _ hφ) (hG.test_fun_preserving _ hφ) + test_fun_preserving' y hφ := + (hF.test_fun_preserving' _ (IsTestFunction.prod_fst hφ)).add + (hG.test_fun_preserving' _ (IsTestFunction.prod_snd hφ)) adjoint φ ψ hφ hψ := by have := hF.test_fun_preserving _ hφ have := hG.test_fun_preserving _ hφ @@ -695,12 +633,8 @@ lemma fst {F'} {F : (X → U) → (X → W×V)} HasVarAdjoint (fun φ x => (F φ x).1) (fun φ x => F' (fun x' => (φ x', 0)) x) where - test_fun_preserving _ hφ := by - apply IsTestFunction.prod_fst - exact hF.test_fun_preserving _ hφ - test_fun_preserving' y hφ := by - apply hF.test_fun_preserving' - fun_prop + test_fun_preserving _ hφ := IsTestFunction.prod_fst (hF.test_fun_preserving _ hφ) + test_fun_preserving' y hφ := hF.test_fun_preserving' _ (by fun_prop) adjoint φ ψ hφ hψ := by calc _ = ∫ (y : X), ⟪F φ y, (ψ y, 0)⟫_ℝ := by simp _ = ∫ (y : X), ⟪φ y, F' (fun y => (ψ y, 0)) y⟫_ℝ := hF.adjoint _ _ hφ (by fun_prop) @@ -721,12 +655,8 @@ lemma snd {F'} {F : (X → U) → (X → W×V)} HasVarAdjoint (fun φ x => (F φ x).2) (fun φ x => F' (fun x' => (0, φ x')) x) where - test_fun_preserving _ hφ := by - apply IsTestFunction.prod_snd - exact hF.test_fun_preserving _ hφ - test_fun_preserving' y hφ := by - apply hF.test_fun_preserving' _ - fun_prop + test_fun_preserving _ hφ := IsTestFunction.prod_snd (hF.test_fun_preserving _ hφ) + test_fun_preserving' y hφ := hF.test_fun_preserving' _ (by fun_prop) adjoint φ ψ hφ hψ := by calc _ = ∫ (y : X), ⟪F φ y, (0, ψ y)⟫_ℝ := by simp _ = ∫ (y : X), ⟪φ y, F' (fun y => (0, ψ y)) y⟫_ℝ := hF.adjoint _ _ hφ (by fun_prop) diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/NoGrav/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/NoGrav/Basic.lean index d1930c7ab..5bb274e22 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/NoGrav/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/NoGrav/Basic.lean @@ -38,15 +38,9 @@ namespace SMNoGrav variable {n : ℕ} -lemma SU2Sol (S : (SMNoGrav n).LinSols) : accSU2 S.val = 0 := by - have hS := S.linearSol - simp only [SMNoGrav_linearACCs] at hS - exact hS ⟨0, by simp⟩ - -lemma SU3Sol (S : (SMNoGrav n).LinSols) : accSU3 S.val = 0 := by - have hS := S.linearSol - simp only [SMNoGrav_linearACCs] at hS - exact hS ⟨1, by simp⟩ +lemma SU2Sol (S : (SMNoGrav n).LinSols) : accSU2 S.val = 0 := S.linearSol ⟨0, by simp⟩ + +lemma SU3Sol (S : (SMNoGrav n).LinSols) : accSU3 S.val = 0 := S.linearSol ⟨1, by simp⟩ lemma cubeSol (S : (SMNoGrav n).Sols) : accCube S.val = 0 := S.cubicSol diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/Basic.lean index 43e21405c..f26d97b53 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/Basic.lean @@ -38,20 +38,11 @@ namespace SM variable {n : ℕ} -lemma gravSol (S : (SM n).LinSols) : accGrav S.val = 0 := by - have hS := S.linearSol - simp only [SM_linearACCs] at hS - exact hS ⟨0, by simp⟩ - -lemma SU2Sol (S : (SM n).LinSols) : accSU2 S.val = 0 := by - have hS := S.linearSol - simp only [SM_linearACCs] at hS - exact hS ⟨1, by simp⟩ - -lemma SU3Sol (S : (SM n).LinSols) : accSU3 S.val = 0 := by - have hS := S.linearSol - simp only [SM_linearACCs] at hS - exact hS ⟨2, by simp⟩ +lemma gravSol (S : (SM n).LinSols) : accGrav S.val = 0 := S.linearSol ⟨0, by simp⟩ + +lemma SU2Sol (S : (SM n).LinSols) : accSU2 S.val = 0 := S.linearSol ⟨1, by simp⟩ + +lemma SU3Sol (S : (SM n).LinSols) : accSU3 S.val = 0 := S.linearSol ⟨2, by simp⟩ lemma cubeSol (S : (SM n).Sols) : accCube S.val = 0 := S.cubicSol diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean index 0c1ca907e..0684a4a6d 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean @@ -36,14 +36,8 @@ def B₀ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₀_cubic (S T : (SM 3).Charges) : cubeTriLin B₀ S T = 6 * (S (0 : Fin 18) * T (0 : Fin 18) - S (1 : Fin 18) * T (1 : Fin 18)) := by - simp only [B₀, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, zero_mul, Nat.reduceMod, - Fin.mk_eq_zero, Nat.div_eq_zero_iff, OfNat.ofNat_ne_zero, false_or, imp_false, isEmpty_Prop, - not_lt, le_add_iff_nonneg_left, zero_le, IsEmpty.forall_iff, Fin.mk_eq_one, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, one_mul, Nat.reduceDiv, Fin.mk_one, neg_mul, - mul_neg, Fin.reduceFinMk] + simp [B₀, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] ring /-- A charge assignment forming one of the basis elements of the plane. -/ @@ -56,12 +50,8 @@ def B₁ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₁_cubic (S T : (SM 3).Charges) : cubeTriLin B₁ S T = 3 * (S (3 : Fin 18) * T (3 : Fin 18) - S (4 : Fin 18) * T (4 : Fin 18)) := by - simp only [B₁, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, Nat.reduceMod, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, zero_mul, zero_add, Fin.mk_one, Fin.reduceFinMk, - one_mul, Nat.reduceDiv, Nat.reduceAdd, neg_mul, mul_neg] + simp [B₁, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] ring /-- A charge assignment forming one of the basis elements of the plane. -/ @@ -74,12 +64,8 @@ def B₂ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₂_cubic (S T : (SM 3).Charges) : cubeTriLin B₂ S T = 3 * (S (6 : Fin 18) * T (6 : Fin 18) - S (7 : Fin 18) * T (7 : Fin 18)) := by - simp only [B₂, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, Nat.reduceMod, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, zero_mul, zero_add, Fin.mk_one, Fin.reduceFinMk, - Nat.reduceDiv, one_mul, Nat.reduceAdd, neg_mul, mul_neg] + simp [B₂, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] ring /-- A charge assignment forming one of the basis elements of the plane. -/ @@ -92,13 +78,9 @@ def B₃ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₃_cubic (S T : (SM 3).Charges) : cubeTriLin B₃ S T = 2 * (S (9 : Fin 18) * T (9 : Fin 18) - S (10 : Fin 18) * T (10 : Fin 18)) := by - simp only [B₃, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, Nat.reduceMod, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, zero_mul, zero_add, Fin.mk_one, Fin.reduceFinMk, - Nat.reduceDiv, one_mul, Nat.reduceAdd, neg_mul, mul_neg] - ring_nf + simp [B₃, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] + ring /-- A charge assignment forming one of the basis elements of the plane. -/ def B₄ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => @@ -110,13 +92,9 @@ def B₄ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₄_cubic (S T : (SM 3).Charges) : cubeTriLin B₄ S T = (S (12 : Fin 18) * T (12 : Fin 18) - S (13 : Fin 18) * T (13 : Fin 18)) := by - simp only [B₄, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, Nat.reduceMod, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, zero_mul, zero_add, Fin.mk_one, Fin.reduceFinMk, - Nat.reduceDiv, one_mul, Nat.reduceAdd, neg_mul] - ring_nf + simp [B₄, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] + ring /-- A charge assignment forming one of the basis elements of the plane. -/ def B₅ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => @@ -128,13 +106,9 @@ def B₅ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₅_cubic (S T : (SM 3).Charges) : cubeTriLin B₅ S T = (S (15 : Fin 18) * T (15 : Fin 18) - S (16 : Fin 18) * T (16 : Fin 18)) := by - simp only [B₅, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, Nat.reduceMod, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, zero_mul, zero_add, Fin.mk_one, Fin.reduceFinMk, - Nat.reduceDiv, one_mul, Nat.reduceAdd, neg_mul] - ring_nf + simp [B₅, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] + ring /-- A charge assignment forming one of the basis elements of the plane. -/ def B₆ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => @@ -146,13 +120,9 @@ def B₆ : (SM 3).Charges := toSpeciesEquiv.invFun (fun s => fun i => set_option backward.isDefEq.respectTransparency false in lemma B₆_cubic (S T : (SM 3).Charges) : cubeTriLin B₆ S T = 3 * (S (5 : Fin 18) * T (5 : Fin 18) - S (8 : Fin 18) * T (8 : Fin 18)) := by - simp only [B₆, Equiv.invFun_as_coe, cubeTriLin_toFun_apply_apply, Fin.isValue, - toSpeciesEquiv_apply, Nat.reduceMul, finProdFinEquiv, Fin.divNat, Fin.modNat, Equiv.coe_fn_mk, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, add_zero, toSpeciesEquiv_symm_apply, Nat.one_mod, - mul_one, Nat.ofNat_pos, Nat.add_div_right, Nat.add_mod_right, Nat.reduceMod, Nat.mod_succ, - Fin.sum_univ_three, Nat.zero_div, Fin.zero_eta, zero_mul, zero_add, Fin.mk_one, Fin.reduceFinMk, - Nat.reduceDiv, Nat.reduceAdd, one_mul, neg_mul, mul_neg] - ring_nf + simp [B₆, cubeTriLin_toFun_apply_apply, finProdFinEquiv, Fin.divNat, Fin.modNat, + Fin.sum_univ_three] + ring TODO "Remove the definitions of elements `(SM 3).Charges` B₀, B₁ etc, here are use only `B : Fin 7 → (SM 3).Charges`. " @@ -172,65 +142,50 @@ lemma B₀_Bi_cubic {i : Fin 7} (hi : 0 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 0) (B i) S = 0 := by change cubeTriLin B₀ (B i) S = 0 rw [B₀_cubic] - norm_num fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₁, B₂, B₃, B₄, B₅, B₆, Fin.divNat, Fin.modNat] + simp_all [B₁, B₂, B₃, B₄, B₅, B₆, Fin.divNat, Fin.modNat] lemma B₁_Bi_cubic {i : Fin 7} (hi : 1 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 1) (B i) S = 0 := by change cubeTriLin B₁ (B i) S = 0 rw [B₁_cubic] fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₀, B₂, B₃, B₄, B₅, B₆, Fin.divNat, Fin.modNat] + simp_all [B₀, B₂, B₃, B₄, B₅, B₆, Fin.divNat, Fin.modNat] lemma B₂_Bi_cubic {i : Fin 7} (hi : 2 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 2) (B i) S = 0 := by change cubeTriLin B₂ (B i) S = 0 rw [B₂_cubic] fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₀, B₁, B₃, B₄, B₅, B₆, Fin.divNat, Fin.modNat] + simp_all [B₀, B₁, B₃, B₄, B₅, B₆, Fin.divNat, Fin.modNat] lemma B₃_Bi_cubic {i : Fin 7} (hi : 3 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 3) (B i) S = 0 := by change cubeTriLin (B₃) (B i) S = 0 rw [B₃_cubic] fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₀, B₁, B₂, B₄, B₅, B₆, Fin.divNat, Fin.modNat] + simp_all [B₀, B₁, B₂, B₄, B₅, B₆, Fin.divNat, Fin.modNat] lemma B₄_Bi_cubic {i : Fin 7} (hi : 4 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 4) (B i) S = 0 := by change cubeTriLin (B₄) (B i) S = 0 rw [B₄_cubic] fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₀, B₁, B₂, B₃, B₅, B₆, Fin.divNat, Fin.modNat] + simp_all [B₀, B₁, B₂, B₃, B₅, B₆, Fin.divNat, Fin.modNat] lemma B₅_Bi_cubic {i : Fin 7} (hi : 5 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 5) (B i) S = 0 := by change cubeTriLin (B₅) (B i) S = 0 rw [B₅_cubic] fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₀, B₁, B₂, B₃, B₄, B₆, Fin.divNat, Fin.modNat] + simp_all [B₀, B₁, B₂, B₃, B₄, B₆, Fin.divNat, Fin.modNat] lemma B₆_Bi_cubic {i : Fin 7} (hi : 6 ≠ i) (S : (SM 3).Charges) : cubeTriLin (B 6) (B i) S = 0 := by change cubeTriLin (B₆) (B i) S = 0 rw [B₆_cubic] fin_cases i <;> - simp only [Fin.isValue, Fin.zero_eta, ne_eq, Fin.reduceEq, not_false_eq_true, Fin.mk_one, - Fin.reduceFinMk, not_true_eq_false] at hi <;> - simp [B₀, B₁, B₂, B₃, B₄, B₅, Fin.divNat, Fin.modNat] + simp_all [B₀, B₁, B₂, B₃, B₄, B₅, Fin.divNat, Fin.modNat] lemma Bi_Bj_ne_cubic {i j : Fin 7} (h : i ≠ j) (S : (SM 3).Charges) : cubeTriLin (B i) (B j) S = 0 := by @@ -249,43 +204,33 @@ lemma Bi_Bi_Bj_cubic (i j : Fin 7) : lemma Bi_Bj_Bk_cubic (i j k : Fin 7) : cubeTriLin (B i) (B j) (B k) = 0 := by - by_cases hij : i ≠ j + rcases eq_or_ne i j with rfl | hij + · exact Bi_Bi_Bj_cubic i k · exact Bi_Bj_ne_cubic hij (B k) - · simp only [ne_eq, Decidable.not_not] at hij - rw [hij] - exact Bi_Bi_Bj_cubic j k set_option backward.isDefEq.respectTransparency false in theorem B_in_accCube (f : Fin 7 → ℚ) : accCube (∑ i, f i • B i) = 0 := by change cubeTriLin _ _ _ = 0 rw [cubeTriLin.map_sum₁₂₃] apply Fintype.sum_eq_zero _ fun i ↦ Fintype.sum_eq_zero _ fun k ↦ Fintype.sum_eq_zero _ fun l ↦ ?_ - rw [cubeTriLin.map_smul₁, cubeTriLin.map_smul₂, cubeTriLin.map_smul₃, Bi_Bj_Bk_cubic] - simp + simp only [cubeTriLin.map_smul₁, cubeTriLin.map_smul₂, cubeTriLin.map_smul₃, Bi_Bj_Bk_cubic, + mul_zero] set_option backward.isDefEq.respectTransparency false in -lemma B_sum_is_sol (f : Fin 7 → ℚ) : (SM 3).IsSolution (∑ i, f i • B i) := by - let X := chargeToAF (∑ i, f i • B i) (by - rw [map_sum] - apply Fintype.sum_eq_zero _ fun i ↦ ?_ - rw [map_smul] - refine smul_eq_zero_of_right (f i) ?_ +lemma B_sum_is_sol (f : Fin 7 → ℚ) : (SM 3).IsSolution (∑ i, f i • B i) := + ⟨chargeToAF (∑ i, f i • B i) (by + simp only [map_sum, map_smul] + refine Fintype.sum_eq_zero _ fun i ↦ smul_eq_zero_of_right _ ?_ with_unfolding_all decide +revert) (by - rw [map_sum] - apply Fintype.sum_eq_zero _ fun i ↦ ?_ - rw [map_smul] - refine smul_eq_zero_of_right (f i) ?_ + simp only [map_sum, map_smul] + refine Fintype.sum_eq_zero _ fun i ↦ smul_eq_zero_of_right _ ?_ with_unfolding_all decide +revert) (by - rw [map_sum] - apply Fintype.sum_eq_zero _ fun i ↦ ?_ - rw [map_smul] - refine smul_eq_zero_of_right (f i) ?_ + simp only [map_sum, map_smul] + refine Fintype.sum_eq_zero _ fun i ↦ smul_eq_zero_of_right _ ?_ with_unfolding_all decide +revert) - (B_in_accCube f) - use X - rfl + (B_in_accCube f), rfl⟩ set_option backward.isDefEq.respectTransparency false in theorem basis_linear_independent : LinearIndependent ℚ B := by @@ -297,23 +242,14 @@ theorem basis_linear_independent : LinearIndependent ℚ B := by have h4 := congrFun h (12 : Fin 18) have h5 := congrFun h (15 : Fin 18) have h6 := congrFun h (5 : Fin 18) - rw [@Fin.sum_univ_seven] at h0 h1 h2 h3 h4 h5 h6 - simp only [HSMul.hSMul, Fin.isValue, B, ACCSystemCharges.chargesAddCommMonoid_add, - ACCSystemCharges.chargesModule_smul] at h0 h1 h2 h3 h4 h5 h6 - rw [B₀, B₁, B₂, B₃, B₄, B₅, B₆] at h0 h1 h2 h3 h4 h5 h6 - simp only [Fin.isValue, Equiv.invFun_as_coe, toSpeciesEquiv_symm_apply, Fin.divNat, Nat.reduceMul, - Fin.coe_ofNat_eq_mod, Nat.zero_mod, Nat.zero_div, Fin.zero_eta, Fin.modNat, mul_one, mul_zero, - add_zero, Nat.reduceMod, Nat.ofNat_pos, Nat.div_self, Fin.mk_one, Nat.mod_self, zero_add, + simp only [Fin.sum_univ_seven, B, B₀, B₁, B₂, B₃, B₄, B₅, B₆, HSMul.hSMul, + ACCSystemCharges.chargesAddCommMonoid_add, ACCSystemCharges.chargesModule_smul, Fin.isValue, + Equiv.invFun_as_coe, toSpeciesEquiv_symm_apply, Fin.divNat, Nat.reduceMul, Fin.coe_ofNat_eq_mod, + Nat.zero_mod, Nat.zero_div, Fin.zero_eta, Fin.modNat, mul_one, mul_zero, add_zero, + Nat.reduceMod, Nat.ofNat_pos, Nat.div_self, Fin.mk_one, Nat.mod_self, zero_add, Nat.reduceDiv, Fin.reduceFinMk] at h0 h1 h2 h3 h4 h5 h6 intro i - match i with - | ⟨0, _⟩ => exact h0 - | ⟨1, _⟩ => exact h1 - | ⟨2, _⟩ => exact h2 - | ⟨3, _⟩ => exact h3 - | ⟨4, _⟩ => exact h4 - | ⟨5, _⟩ => exact h5 - | ⟨6, _⟩ => exact h6 + fin_cases i <;> assumption end PlaneSeven diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean index 88ba7d690..b9cfeea19 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean @@ -68,9 +68,7 @@ lemma toSpecies_sum_invariant (m : ℕ) (f : PermGroup n) (S : (SMνCharges n).C ∑ i, ((fun a => a ^ m) ∘ toSpecies j (repCharges f S)) i = ∑ i, ((fun a => a ^ m) ∘ toSpecies j S) i := by rw [repCharges_toSpecies] - change ∑ i : Fin n, ((fun a => a ^ m) ∘ _) (⇑(f⁻¹ _) i) = ∑ i : Fin n, ((fun a => a ^ m) ∘ _) i - refine Equiv.Perm.sum_comp _ _ _ ?_ - simp only [PermGroup, Pi.inv_apply, ne_eq, coe_univ, Set.subset_univ] + exact Equiv.sum_comp (f⁻¹ j) ((fun a => a ^ m) ∘ toSpecies j S) lemma accGrav_invariant (f : PermGroup n) (S : (SMνCharges n).Charges) : accGrav (repCharges f S) = accGrav S := diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BoundPlaneDim.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BoundPlaneDim.lean index 290649420..a837dc50a 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BoundPlaneDim.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BoundPlaneDim.lean @@ -35,34 +35,25 @@ lemma exists_plane_exists_basis {n : ℕ} (hE : ExistsPlane n) : obtain ⟨B, hB1, hB2⟩ := eleven_dim_plane_of_no_sols_exists let Y := Sum.elim B E refine ⟨Y, Fintype.linearIndependent_iff.mpr fun g hg ↦ ?_⟩ - rw [@Fintype.sum_sum_type, @add_eq_zero_iff_eq_neg, ← @Finset.sum_neg_distrib] at hg - have h1 : ∑ x : Fin n, -(g (Sum.inr x) • Y (Sum.inr x)) = - ∑ x : Fin n, (-g (Sum.inr x)) • Y (Sum.inr x) := by - apply Finset.sum_congr rfl - intro i _ - simp - rw [h1] at hg + rw [Fintype.sum_sum_type, add_eq_zero_iff_eq_neg] at hg + simp only [← Finset.sum_neg_distrib, ← neg_smul] at hg have h2 : ∑ a₁ : Fin 11, g (Sum.inl a₁) • Y (Sum.inl a₁) = 0 := by apply hB2 erw [hg] exact hE2 fun i => -g (Sum.inr i) rw [Fintype.linearIndependent_iff] at hB1 hE1 - have h3 : ∀ i, g (Sum.inl i) = 0 := hB1 (fun i => (g (Sum.inl i))) h2 + have h3 : ∀ i, g (Sum.inl i) = 0 := hB1 (fun i => g (Sum.inl i)) h2 rw [h2] at hg - have h4 : ∀ i, - g (Sum.inr i) = 0 := hE1 (fun i => (- g (Sum.inr i))) hg.symm + have h4 := hE1 (fun i => -g (Sum.inr i)) hg.symm simp only [neg_eq_zero] at h4 - intro i - match i with - | Sum.inl i => exact h3 i - | Sum.inr i => exact h4 i + exact fun i => i.rec h3 h4 theorem plane_exists_dim_le_7 {n : ℕ} (hn : ExistsPlane n) : n ≤ 7 := by obtain ⟨B, hB⟩ := exists_plane_exists_basis hn have h1 := LinearIndependent.fintype_card_le_finrank hB - simp only [Fintype.card_sum, Fintype.card_fin] at h1 - rw [show Module.finrank ℚ (PlusU1 3).Charges = 18 from - Module.finrank_fin_fun ℚ] at h1 - exact Nat.le_of_add_le_add_left h1 + simp only [Fintype.card_sum, Fintype.card_fin, + show Module.finrank ℚ (PlusU1 3).Charges = 18 from Module.finrank_fin_fun ℚ] at h1 + omega end PlusU1 end SMRHN diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean index 01e349073..ce70e492c 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean @@ -51,8 +51,7 @@ lemma α₂_AFQ (S : (PlusU1 n).QuadSols) : α₂ S.1 = 0 := quadSol S lemma accQuad_α₁_α₂ (S : (PlusU1 n).LinSols) : accQuad ((α₁ C S) • S + α₂ S • C.1).val = 0 := by - erw [add_AFL_quad] - rw [α₁, α₂] + erw [add_AFL_quad, α₁, α₂] ring lemma accQuad_α₁_α₂_zero (S : (PlusU1 n).LinSols) (h1 : α₁ C S = 0) @@ -71,8 +70,7 @@ lemma genericToQuad_on_quad (S : (PlusU1 n).QuadSols) : genericToQuad C S.1 = (α₁ C S.1) • S := by apply ACCSystemQuad.QuadSols.ext change ((α₁ C S.1) • S.val + α₂ S.1 • C.val) = (α₁ C S.1) • S.val - rw [α₂_AFQ] - simp + simp [α₂_AFQ] lemma genericToQuad_ne_zero (S : (PlusU1 n).QuadSols) (h : α₁ C S.1 ≠ 0) : (α₁ C S.1)⁻¹ • genericToQuad C S.1 = S := by @@ -120,15 +118,14 @@ lemma toQuadInv_special (S : (PlusU1 n).QuadSols) (h : α₁ C S.1 = 0) : specialToQuad C (toQuadInv C S).1 (toQuadInv C S).2.1 (toQuadInv C S).2.2 ((toQuadInv_α₁_α₂ C S).mp h).1 ((toQuadInv_α₁_α₂ C S).mp h).2 = S := by simp only [toQuadInv_fst] - rw [show (toQuadInv C S).2.1 = 1 by rw [toQuadInv, if_pos h]] - rw [show (toQuadInv C S).2.2 = 0 by rw [toQuadInv, if_pos h]] - rw [special_on_quad] + rw [show (toQuadInv C S).2.1 = 1 by rw [toQuadInv, if_pos h], + show (toQuadInv C S).2.2 = 0 by rw [toQuadInv, if_pos h], special_on_quad] lemma toQuadInv_generic (S : (PlusU1 n).QuadSols) (h : α₁ C S.1 ≠ 0) : (toQuadInv C S).2.1 • genericToQuad C (toQuadInv C S).1 = S := by simp only [toQuadInv_fst] - rw [show (toQuadInv C S).2.1 = (α₁ C S.1)⁻¹ by rw [toQuadInv, if_neg h]] - rw [genericToQuad_ne_zero C S h] + rw [show (toQuadInv C S).2.1 = (α₁ C S.1)⁻¹ by rw [toQuadInv, if_neg h], + genericToQuad_ne_zero C S h] lemma toQuad_rightInverse : Function.RightInverse (@toQuadInv n C) (toQuad C) := by intro S diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean index e7a1bdb23..af133c8e3 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean @@ -50,7 +50,6 @@ open InnerProductSpace lemma ext_of_fst_snd {H1 H2 : TwoHiggsDoublet} (h1 : H1.Φ1 = H2.Φ1) (h2 : H1.Φ2 = H2.Φ2) : H1 = H2 := by cases H1 - cases H2 congr /-! diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean index 75c440964..3583671c1 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean @@ -279,8 +279,7 @@ lemma massTerm_eq_gramVector (P : PotentialParameters) (H : TwoHiggsDoublet) : lemma gaugeGroupI_smul_massTerm (g : StandardModel.GaugeGroupI) (P : PotentialParameters) (H : TwoHiggsDoublet) : massTerm P (g • H) = massTerm P H := by - rw [massTerm_eq_gramVector, massTerm_eq_gramVector] - simp + simp [massTerm_eq_gramVector] @[simp] lemma massTerm_zero : massTerm 0 = 0 := by @@ -291,8 +290,7 @@ lemma massTerm_stabilityCounterExample (H : TwoHiggsDoublet) : massTerm PotentialParameters.stabilityCounterExample H = 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).im := by simp [massTerm, PotentialParameters.stabilityCounterExample] - rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] - rw [Complex.conj_im] + rw [← inner_conj_symm H.Φ2 H.Φ1, Complex.conj_im] ring_nf /-! @@ -323,12 +321,8 @@ lemma quarticTerm_𝓵₄_expand (P : PotentialParameters) (H : TwoHiggsDoublet) + (P.𝓵₇ * ‖H.Φ2‖ ^ 2 * ⟪H.Φ1, H.Φ2⟫_ℂ + conj P.𝓵₇ * ‖H.Φ2‖ ^ 2 * ⟪H.Φ2, H.Φ1⟫_ℂ).re := by simp [quarticTerm] left - rw [Complex.sq_norm] - rw [← Complex.mul_re] - rw [← inner_conj_symm, ← Complex.normSq_eq_conj_mul_self] - simp only [inner_conj_symm, Complex.ofReal_re] - rw [← inner_conj_symm] - exact Complex.normSq_conj ⟪H.Φ2, H.Φ1⟫_ℂ + rw [Complex.sq_norm, ← inner_conj_symm H.Φ2 H.Φ1, ← Complex.mul_re, Complex.mul_conj, + Complex.ofReal_re] lemma quarticTerm_eq_gramVector (P : PotentialParameters) (H : TwoHiggsDoublet) : quarticTerm P H = ∑ a, ∑ b, H.gramVector a * H.gramVector b * P.η a b := by @@ -343,8 +337,7 @@ lemma quarticTerm_eq_gramVector (P : PotentialParameters) (H : TwoHiggsDoublet) lemma gaugeGroupI_smul_quarticTerm (g : StandardModel.GaugeGroupI) (P : PotentialParameters) (H : TwoHiggsDoublet) : quarticTerm P (g • H) = quarticTerm P H := by - rw [quarticTerm_eq_gramVector, quarticTerm_eq_gramVector] - simp + simp [quarticTerm_eq_gramVector] @[simp] lemma quarticTerm_zero : quarticTerm 0 = 0 := by @@ -354,7 +347,6 @@ lemma quarticTerm_zero : quarticTerm 0 = 0 := by lemma quarticTerm_stabilityCounterExample (H : TwoHiggsDoublet) : quarticTerm .stabilityCounterExample H = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 - 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re) ^ 2:= by - /- Proof by calculation. -/ calc _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) ^ 2 + 2 * ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 + (⟪H.Φ1, H.Φ2⟫_ℂ ^ 2 + ⟪H.Φ2, H.Φ1⟫_ℂ ^ 2).re @@ -362,39 +354,17 @@ lemma quarticTerm_stabilityCounterExample (H : TwoHiggsDoublet) : simp [quarticTerm, PotentialParameters.stabilityCounterExample, Complex.add_re, ← Complex.ofReal_pow] ring - _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) ^ 2 - + 4 * (⟪H.Φ1, H.Φ2⟫_ℂ).re ^ 2 - - 2 * (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) * ((⟪H.Φ1, H.Φ2⟫_ℂ).re + (⟪H.Φ2, H.Φ1⟫_ℂ).re) := by - have h1 : 2 * ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 - + (⟪H.Φ1, H.Φ2⟫_ℂ ^ 2 + ⟪H.Φ2, H.Φ1⟫_ℂ ^ 2).re = 4 * (⟪H.Φ1, H.Φ2⟫_ℂ).re ^ 2 := by - rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1), - ← Complex.normSq_eq_norm_sq, Complex.normSq_apply, sq, sq, sq] - simp only [Complex.add_re, Complex.mul_re, Complex.conj_re, Complex.conj_im] - ring - rw [← h1] - ring _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 - 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re) ^ 2 := by - rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] - rw [Complex.conj_re] + rw [← inner_conj_symm H.Φ2 H.Φ1, ← Complex.normSq_eq_norm_sq, Complex.normSq_apply] + simp only [Complex.add_re, Complex.mul_re, Complex.conj_re, Complex.conj_im, pow_two] ring lemma quarticTerm_stabilityCounterExample_eq_norm_pow_four (H : TwoHiggsDoublet) : quarticTerm .stabilityCounterExample H = ‖H.Φ1 - H.Φ2‖ ^ 4 := by - /- Proof by calculation. -/ - calc _ - _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 - 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re) ^ 2 := by - rw [quarticTerm_stabilityCounterExample] - _ = (‖H.Φ1 - H.Φ2‖ ^ 2) ^ 2 := by - congr - have h1 (v : HiggsVec) : ‖v‖ ^ 2 = (⟪v, v⟫_ℂ).re := by - rw [inner_self_eq_norm_sq_to_K] - simp [← Complex.ofReal_pow] - rw [h1, h1, h1] - simp only [inner_sub_right, inner_sub_left, Complex.sub_re] - rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] - rw [Complex.conj_re] - ring - _ = ‖H.Φ1 - H.Φ2‖ ^ 4 := by ring + rw [quarticTerm_stabilityCounterExample] + rw [show ‖H.Φ1 - H.Φ2‖ ^ 4 = (‖H.Φ1 - H.Φ2‖ ^ 2) ^ 2 from by ring, norm_sub_sq (𝕜 := ℂ), + RCLike.re_to_complex] + ring lemma quarticTerm_stabilityCounterExample_nonneg (H : TwoHiggsDoublet) : 0 ≤ quarticTerm .stabilityCounterExample H := by @@ -406,8 +376,7 @@ lemma massTerm_zero_of_quarticTerm_zero_stabilityCounterExample (H : TwoHiggsDou massTerm .stabilityCounterExample H = 0 := by rw [quarticTerm_stabilityCounterExample_eq_norm_pow_four] at h rw [massTerm_stabilityCounterExample] - simp at h - have h1 : H.Φ1 = H.Φ2 := by rw [← sub_eq_zero, h] + have h1 : H.Φ1 = H.Φ2 := by simpa [sub_eq_zero] using h simp [← Complex.ofReal_pow, h1] /-! @@ -427,8 +396,7 @@ noncomputable def potential (P : PotentialParameters) (H : TwoHiggsDoublet) : lemma gaugeGroupI_smul_potential (g : StandardModel.GaugeGroupI) (P : PotentialParameters) (H : TwoHiggsDoublet) : potential P (g • H) = potential P H := by - rw [potential, potential] - simp + simp [potential] @[simp] lemma potential_zero : potential 0 = 0 := by @@ -585,10 +553,7 @@ lemma massTermReduced_lower_bound (P : PotentialParameters) (k : EuclideanSpace · simp simp at hk have ha (a b : ℝ) (h : a ≤ 1) (ha : 0 ≤ a) (hb : 0 ≤ b) : a * b ≤ b := by nlinarith - apply ha - · exact hk - · exact norm_nonneg k - · exact norm_nonneg ξEuclid + exact ha _ _ hk (norm_nonneg k) (norm_nonneg ξEuclid) trans - ‖⟪k, ξEuclid⟫_ℝ‖ · simp exact abs_real_inner_le_norm k ξEuclid @@ -657,21 +622,15 @@ lemma potentialIsStable_iff_forall_gramVector (P : PotentialParameters) : ∑ μ : Fin 3, K (Sum.inr μ) ^ 2 ≤ K (Sum.inl 0) ^ 2 → c ≤ ∑ μ, P.ξ μ * K μ + ∑ a, ∑ b, K a * K b * P.η a b := by apply Iff.intro - · intro h - obtain ⟨c, hc⟩ := h - use c - intro v hv₀ hv_sum + · rintro ⟨c, hc⟩ + refine ⟨c, fun v hv₀ hv_sum => ?_⟩ obtain ⟨H, hH⟩ := gramVector_surjective v hv₀ hv_sum - apply (hc H).trans - apply le_of_eq + refine (hc H).trans (le_of_eq ?_) rw [potential, massTerm_eq_gramVector, quarticTerm_eq_gramVector] simp [hH] - · intro h - obtain ⟨c, hc⟩ := h - use c - intro H - apply (hc H.gramVector (gramVector_inl_nonneg H) (gramVector_inr_sum_sq_le_inl H)).trans - apply le_of_eq + · rintro ⟨c, hc⟩ + refine ⟨c, fun H => (hc H.gramVector (gramVector_inl_nonneg H) + (gramVector_inr_sum_sq_le_inl H)).trans (le_of_eq ?_)⟩ rw [potential, massTerm_eq_gramVector, quarticTerm_eq_gramVector] lemma potentialIsStable_iff_forall_euclid (P : PotentialParameters) : @@ -687,19 +646,14 @@ lemma potentialIsStable_iff_forall_euclid (P : PotentialParameters) : Finset.sum_singleton, Prod.forall, Equiv.sumArrowEquivProdArrow_symm_apply_inl, Equiv.sumArrowEquivProdArrow_symm_apply_inr] rw [Equiv.forall_congr_left <| Equiv.funUnique (Fin 1) ℝ] - apply forall_congr' - intro K0 + refine forall_congr' fun K0 => ?_ rw [Equiv.forall_congr_left <| (WithLp.equiv 2 ((i : Fin 3) → (fun x => ℝ) i)).symm] - apply forall_congr' - intro K + refine forall_congr' fun K => ?_ simp only [Fin.isValue, Equiv.funUnique_symm_apply, uniqueElim_const, Equiv.symm_symm, WithLp.equiv_apply] - refine imp_congr_right ?_ - intro hle - simp only [PiLp.norm_sq_eq_of_L2] - simp only [Fin.isValue, Real.norm_eq_abs, sq_abs] - refine imp_congr_right ?_ - intro hle' + refine imp_congr_right fun _ => ?_ + simp only [PiLp.norm_sq_eq_of_L2, Fin.isValue, Real.norm_eq_abs, sq_abs] + refine imp_congr_right fun _ => ?_ apply le_iff_le_of_cmp_eq_cmp congr 1 simp [add_assoc, sq, Finset.sum_add_distrib] @@ -718,17 +672,11 @@ lemma potentialIsStable_iff_forall_euclid_lt (P : PotentialParameters) : ∑ a, ∑ b, K a * K b * P.η (Sum.inr a) (Sum.inr b) := by rw [potentialIsStable_iff_forall_euclid] apply Iff.intro - · intro h - obtain ⟨c, hc⟩ := h - use c - apply And.intro - · simpa using hc 0 0 (by simp) (by simp) - · intro K0 K hk0 hle - exact hc K0 K hk0.le hle - · intro h - obtain ⟨c, hc₀, hc⟩ := h - use c - intro K0 K hK0 hle + · rintro ⟨c, hc⟩ + refine ⟨c, ?_, fun K0 K hk0 hle => hc K0 K hk0.le hle⟩ + simpa using hc 0 0 (by simp) (by simp) + · rintro ⟨c, hc₀, hc⟩ + refine ⟨c, fun K0 K hK0 hle => ?_⟩ by_cases hK0' : K0 = 0 · subst hK0' simp_all @@ -883,7 +831,6 @@ lemma massTermReduced_pos_of_quarticTermReduced_zero_potentialIsStable (P : Pote specialize hc k hk rw [hq] at hc simp only [le_refl, mul_zero, zero_mul, sq_nonpos_iff, true_and] at hc - generalize massTermReduced P k = j2 at * grind /-! @@ -903,17 +850,14 @@ lemma potentialIsStable_of_strong (P : PotentialParameters) PotentialIsStable P := by rw [potentialIsStable_iff_massTermReduced_sq_le_quarticTermReduced] let S := Metric.closedBall (0 : EuclideanSpace ℝ (Fin 3)) 1 - have S_isCompact : IsCompact S := isCompact_closedBall 0 1 have S_nonEmpty : S.Nonempty := ⟨0, by simp [S]⟩ obtain ⟨kmax, kmax_S, kmax_isMax⟩ := IsCompact.exists_isMaxOn (isCompact_closedBall 0 1) S_nonEmpty (f := fun k => (massTermReduced P k ^ 2) / (4 * quarticTermReduced P k)) <| by apply ContinuousOn.div₀ - · apply Continuous.continuousOn - simp only [massTermReduced, Fin.isValue] + · simp only [massTermReduced, Fin.isValue] fun_prop - · apply Continuous.continuousOn - simp only [quarticTermReduced, Fin.isValue] + · simp only [quarticTermReduced, Fin.isValue] fun_prop · intro x hx specialize h x (by simpa using hx) @@ -954,17 +898,12 @@ lemma forall_reduced_exists_not_potentialIsStable : - The mass term is of the form `-(k - z) · w` for some `w` orthogonal to `z`, so as `k - z` approaches orthogonal to `z`, the mass term becomes small only on the account that the abs of `k - z` becomes small. -/ - use .stabilityCounterExample - apply And.intro - /- The condition that P is not stable. -/ - · exact stabilityCounterExample_not_potentialIsStable - /- The condition on the reduced terms. -/ - · refine fun k hk => And.intro (quarticTermReduced_stabilityCounterExample_nonneg k) - (fun hq => ?_) - simp [quarticTermReduced_stabilityCounterExample] at hq - simp only [PiLp.norm_sq_eq_of_L2, Real.norm_eq_abs, sq_abs, Fin.sum_univ_three, - Fin.isValue] at hk - have hk1 : k 1 = 0 := by nlinarith - rw [massTermReduced_stabilityCounterExample, hk1] + refine ⟨.stabilityCounterExample, stabilityCounterExample_not_potentialIsStable, + fun k hk => ⟨quarticTermReduced_stabilityCounterExample_nonneg k, fun hq => ?_⟩⟩ + simp [quarticTermReduced_stabilityCounterExample] at hq + simp only [PiLp.norm_sq_eq_of_L2, Real.norm_eq_abs, sq_abs, Fin.sum_univ_three, + Fin.isValue] at hk + have hk1 : k 1 = 0 := by nlinarith + rw [massTermReduced_stabilityCounterExample, hk1] end TwoHiggsDoublet diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean index a6060d534..4e444f671 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean @@ -35,15 +35,7 @@ def phaseShiftMatrix (a b c : ℝ) : Matrix (Fin 3) (Fin 3) ℂ := /-- The phase shift matrix for zero-phases is the identity. -/ lemma phaseShiftMatrix_one : phaseShiftMatrix 0 0 0 = 1 := by ext i j - fin_cases i <;> fin_cases j - any_goals rfl - · simp only [phaseShiftMatrix, ofReal_zero, mul_zero, exp_zero, Fin.zero_eta, Fin.isValue, - cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, one_apply_eq] - · simp only [phaseShiftMatrix, ofReal_zero, mul_zero, exp_zero, Fin.mk_one, Fin.isValue, - cons_val', cons_val_one, cons_val_zero, empty_val', cons_val_fin_one, one_apply_eq] - · simp only [phaseShiftMatrix, ofReal_zero, mul_zero, exp_zero, Fin.reduceFinMk, cons_val', - Fin.isValue, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons, head_cons, empty_val', - cons_val_fin_one, head_fin_const, one_apply_eq] + fin_cases i <;> fin_cases j <;> simp [phaseShiftMatrix, one_apply] /-- The conjugate transpose of the phase shift matrix is the phase-shift matrix with negated phases. -/ @@ -51,13 +43,7 @@ lemma phaseShiftMatrix_star (a b c : ℝ) : (phaseShiftMatrix a b c)ᴴ = phaseShiftMatrix (- a) (- b) (- c) := by funext i j fin_cases i <;> fin_cases j <;> - simp only [phaseShiftMatrix, Fin.zero_eta, Fin.isValue, conjTranspose_apply, cons_val', - cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, star_def, ← exp_conj, - _root_.map_mul, conj_I, conj_ofReal, neg_mul, ofReal_neg, mul_neg, Fin.mk_one, cons_val_one, - head_fin_const, star_zero, head_cons, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, - tail_val', head_val', tail_cons, Fin.reduceFinMk, map_eq_zero] - · rfl - · rfl + simp [phaseShiftMatrix, conjTranspose_apply, ← exp_conj, conj_I, conj_ofReal] /-- The multiple of two phase shift matrices is equal to the phase shift matrix with added phases. -/ @@ -65,13 +51,7 @@ lemma phaseShiftMatrix_mul (a b c d e f : ℝ) : phaseShiftMatrix a b c * phaseShiftMatrix d e f = phaseShiftMatrix (a + d) (b + e) (c + f) := by ext i j fin_cases i <;> fin_cases j <;> - simp only [phaseShiftMatrix, Fin.zero_eta, Fin.isValue, mul_apply, cons_val', empty_val', - cons_val_fin_one, cons_val_zero, vecCons_const, Fin.sum_univ_three, cons_val_one, head_cons, - head_fin_const, mul_zero, add_zero, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons, - tail_val', head_val', zero_mul, ofReal_add, Fin.mk_one, Fin.reduceFinMk, zero_add] - any_goals rw [mul_add, exp_add] - change cexp (I * ↑c) * 0 = 0 - simp + simp [phaseShiftMatrix, mul_apply, Fin.sum_univ_three, ← exp_add, mul_add] /-- Given three real numbers `a b c` the unitary matrix with `exp (I * a)` etc on the leading diagonal. -/ @@ -95,36 +75,25 @@ def PhaseShiftRelation (U V : unitaryGroup (Fin 3) ℂ) : Prop := /-- The relation `PhaseShiftRelation` is reflective. -/ lemma phaseShiftRelation_refl (U : unitaryGroup (Fin 3) ℂ) : PhaseShiftRelation U U := by - use 0, 0, 0, 0, 0, 0 - rw [Subtype.ext_iff] - simp only [Submonoid.coe_mul, phaseShift_coe_matrix] - rw [phaseShiftMatrix_one] - simp only [one_mul, mul_one] + refine ⟨0, 0, 0, 0, 0, 0, ?_⟩ + simp only [Subtype.ext_iff, Submonoid.coe_mul, phaseShift_coe_matrix, phaseShiftMatrix_one, + one_mul, mul_one] /-- The relation `PhaseShiftRelation` is symmetric. -/ lemma phaseShiftRelation_symm {U V : unitaryGroup (Fin 3) ℂ} : PhaseShiftRelation U V → PhaseShiftRelation V U := by - intro h - obtain ⟨a, b, c, e, f, g, h⟩ := h - use (- a), (- b), (- c), (- e), (- f), (- g) - rw [Subtype.ext_iff] - rw [h] - repeat rw [mul_assoc] - simp only [Submonoid.coe_mul, phaseShift_coe_matrix] - rw [phaseShiftMatrix_mul] - repeat rw [← mul_assoc] - simp only [phaseShiftMatrix_mul, neg_add_cancel, phaseShiftMatrix_one, one_mul, add_neg_cancel, - mul_one] + rintro ⟨a, b, c, e, f, g, rfl⟩ + refine ⟨-a, -b, -c, -e, -f, -g, ?_⟩ + simp only [Subtype.ext_iff, Submonoid.coe_mul, phaseShift_coe_matrix, mul_assoc, + phaseShiftMatrix_mul, add_neg_cancel, phaseShiftMatrix_one, mul_one] + simp only [← mul_assoc, phaseShiftMatrix_mul, neg_add_cancel, phaseShiftMatrix_one, one_mul] /-- The relation `PhaseShiftRelation` is transitive. -/ lemma phaseShiftRelation_trans {U V W : unitaryGroup (Fin 3) ℂ} : PhaseShiftRelation U V → PhaseShiftRelation V W → PhaseShiftRelation U W := by - intro hUV hVW - obtain ⟨a, b, c, e, f, g, hUV⟩ := hUV - obtain ⟨d, i, j, k, l, m, hVW⟩ := hVW - use (a + d), (b + i), (c + j), (e + k), (f + l), (g + m) - rw [Subtype.ext_iff, hUV, hVW] - simp only [Submonoid.coe_mul, phaseShift_coe_matrix] + rintro ⟨a, b, c, e, f, g, rfl⟩ ⟨d, i, j, k, l, m, rfl⟩ + refine ⟨a + d, b + i, c + j, e + k, f + l, g + m, ?_⟩ + simp only [Subtype.ext_iff, Submonoid.coe_mul, phaseShift_coe_matrix] rw [mul_assoc, mul_assoc, phaseShiftMatrix_mul, ← mul_assoc, ← mul_assoc, phaseShiftMatrix_mul, add_comm k e, add_comm l f, add_comm m g] @@ -138,11 +107,7 @@ lemma phaseShiftRelation_equiv : Equivalence PhaseShiftRelation where def CKMMatrix : Type := unitaryGroup (Fin 3) ℂ /-- Two CKM matrices are equal if their underlying unitary matrices are equal. -/ -lemma CKMMatrix_ext {U V : CKMMatrix} (h : U.val = V.val) : U = V := by - cases U - cases V - subst h - rfl +lemma CKMMatrix_ext {U V : CKMMatrix} (h : U.val = V.val) : U = V := Subtype.ext h /-- The `ud`th element of the CKM matrix. -/ scoped[CKMMatrix] notation (name := ud_element) "[" V "]ud" => V.1 0 0 @@ -185,121 +150,60 @@ namespace phaseShiftApply lemma equiv (V : CKMMatrix) (a b c d e f : ℝ) : V ≈ phaseShiftApply V a b c d e f := by symm - use a, b, c, d, e, f - rfl + exact ⟨a, b, c, d, e, f, rfl⟩ /-- The `ud` component of the CKM matrix obtained after applying a phase shift. -/ lemma ud (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 0 0 = cexp (a * I + d * I) * V.1 0 0 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_one, zero_mul, add_zero, cons_val_two, tail_cons, head_cons, mul_zero, tail_val', - head_val'] - change _ + _ * _ * 0 = _ - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `us` component of the CKM matrix obtained after applying a phase shift. -/ lemma us (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 0 1 = cexp (a * I + e * I) * V.1 0 1 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_one, head_cons, zero_mul, add_zero, cons_val_two, tail_cons, mul_zero, zero_add, - head_fin_const] - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `ub` component of the CKM matrix obtained after applying a phase shift. -/ lemma ub (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 0 2 = cexp (a * I + f * I) * V.1 0 2 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_one, head_cons, zero_mul, add_zero, cons_val_two, tail_cons, mul_zero, head_fin_const, - zero_add] - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `cd` component of the CKM matrix obtained after applying a phase shift. -/ lemma cd (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 1 0= cexp (b * I + d * I) * V.1 1 0 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_one, zero_mul, zero_add, cons_val_two, tail_cons, head_cons, add_zero, mul_zero, - tail_val', head_val'] - change _ + _ * _ * 0 = _ - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `cs` component of the CKM matrix obtained after applying a phase shift. -/ lemma cs (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 1 1 = cexp (b * I + e * I) * V.1 1 1 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_one, head_fin_const, zero_mul, head_cons, zero_add, cons_val_two, tail_cons, add_zero, - mul_zero] - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `cb` component of the CKM matrix obtained after applying a phase shift. -/ lemma cb (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 1 2 = cexp (b * I + f * I) * V.1 1 2 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_one, head_fin_const, zero_mul, head_cons, zero_add, cons_val_two, tail_cons, add_zero, - mul_zero] - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `td` component of the CKM matrix obtained after applying a phase shift. -/ lemma td (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 2 0= cexp (c * I + d * I) * V.1 2 0 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_two, tail_val', head_val', cons_val_one, head_cons, tail_cons, head_fin_const, - zero_mul, add_zero, mul_zero] - change (0 * _ + _) * _ + (0 * _ + _) * 0 = _ - simp only [Fin.isValue, zero_mul, zero_add, mul_zero, add_zero] - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `ts` component of the CKM matrix obtained after applying a phase shift. -/ lemma ts (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 2 1 = cexp (c * I + e * I) * V.1 2 1 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_two, tail_val', head_val', cons_val_one, head_cons, tail_cons, head_fin_const, - zero_mul, add_zero, mul_zero, zero_add] - change (0 * _ + _) * _ = _ - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf /-- The `tb` component of the CKM matrix obtained after applying a phase shift. -/ lemma tb (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 2 2 = cexp (c * I + f * I) * V.1 2 2 := by - simp only [Fin.isValue, phaseShiftApply_coe] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, vecCons_const, - cons_val_two, tail_val', head_val', cons_val_one, head_cons, tail_cons, head_fin_const, - zero_mul, add_zero, mul_zero, zero_add] - change (0 * _ + _) * _ = _ - rw [exp_add] + simp [phaseShiftApply_coe, mul_apply, Fin.sum_univ_three, exp_add] ring_nf end phaseShiftApply @@ -312,23 +216,11 @@ def VAbs' (V : unitaryGroup (Fin 3) ℂ) (i j : Fin 3) : ℝ := norm (V i j) are the same. -/ lemma VAbs'_equiv (i j : Fin 3) (V U : CKMMatrix) (h : V ≈ U) : VAbs' V i j = VAbs' U i j := by - simp only [VAbs'] - obtain ⟨a, b, c, e, f, g, h⟩ := h - rw [h] - simp only [Submonoid.coe_mul, phaseShift_coe_matrix] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, Fin.sum_univ_three] - rw [mul_apply, mul_apply, Fin.sum_univ_three, Fin.sum_univ_three] - simp only [phaseShiftMatrix, Fin.isValue, cons_val', cons_val_zero, empty_val', cons_val_fin_one, - vecCons_const, cons_val_one, cons_val_two, tail_cons, head_cons, head_fin_const] + obtain ⟨a, b, c, e, f, g, rfl⟩ := h + simp only [VAbs', Submonoid.coe_mul, phaseShift_coe_matrix, phaseShiftMatrix, mul_apply, + Fin.sum_univ_three] fin_cases i <;> fin_cases j <;> - simp only [Fin.zero_eta, Fin.isValue, cons_val_zero, zero_mul, add_zero, mul_zero, - mul_re, I_re, ofReal_re, I_im, ofReal_im, sub_self, Real.exp_zero, - one_mul, mul_one,Fin.mk_one, cons_val_one, head_cons, zero_add, - head_fin_const, Fin.reduceFinMk, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons, - tail_val', head_val', Complex.norm_exp, Complex.norm_mul] - all_goals change norm (0 * _ + _) = _ - all_goals simp [Complex.norm_exp] + simp [Complex.norm_exp, mul_comm] /-- The absolute value of the `(i,j)`th any representative of `⟦V⟧`. -/ def VAbs (i j : Fin 3) : Quotient CKMMatrixSetoid → ℝ := @@ -414,9 +306,8 @@ def Rcdcb (V : CKMMatrix) : ℂ := [V]cd / [V]cb /-- The ratio of the `cd` and `cb` elements of a CKM matrix. -/ scoped[CKMMatrix] notation (name := cd_cb_ratio) "[" V "]cd|cb" => Rcdcb V -lemma Rcdcb_mul_cb {V : CKMMatrix} (h : [V]cb ≠ 0) : [V]cd = Rcdcb V * [V]cb := by - rw [Rcdcb] - exact (div_mul_cancel₀ (V.1 1 0) h).symm +lemma Rcdcb_mul_cb {V : CKMMatrix} (h : [V]cb ≠ 0) : [V]cd = Rcdcb V * [V]cb := + (div_mul_cancel₀ (V.1 1 0) h).symm /-- The ratio of the `cs` and `cb` elements of a CKM matrix. -/ def Rcscb (V : CKMMatrix) : ℂ := [V]cs / [V]cb @@ -426,9 +317,8 @@ scoped[CKMMatrix] notation (name := cs_cb_ratio) "[" V "]cs|cb" => Rcscb V /-- Multiplying the ratio of the `cs` by `cb` element of a CKM matrix by the `cb` element returns the `cs` element, as long as the `cb` element is non-zero. -/ -lemma Rcscb_mul_cb {V : CKMMatrix} (h : [V]cb ≠ 0) : [V]cs = Rcscb V * [V]cb := by - rw [Rcscb] - exact (div_mul_cancel₀ [V]cs h).symm +lemma Rcscb_mul_cb {V : CKMMatrix} (h : [V]cb ≠ 0) : [V]cs = Rcscb V * [V]cb := + (div_mul_cancel₀ [V]cs h).symm end ratios diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/Invariants.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/Invariants.lean index 0b9eae401..168888bdb 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/Invariants.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/Invariants.lean @@ -37,15 +37,9 @@ lemma jarlskogℂCKM_equiv (V U : CKMMatrix) (h : V ≈ U) : obtain ⟨a, b, c, e, f, g, h⟩ := h change V = phaseShiftApply U a b c e f g at h rw [h] - simp only [jarlskogℂCKM, Fin.isValue, phaseShiftApply.ub, - phaseShiftApply.us, phaseShiftApply.cb, phaseShiftApply.cs] - simp only [exp_add, Fin.isValue, _root_.map_mul, ← exp_conj, conj_ofReal, conj_I, mul_neg, - exp_neg] - have ha : cexp (↑a * I) ≠ 0 := exp_ne_zero _ - have hb : cexp (↑b * I) ≠ 0 := exp_ne_zero _ - have hf : cexp (↑f * I) ≠ 0 := exp_ne_zero _ - have hg : cexp (↑g * I) ≠ 0 := exp_ne_zero _ - field_simp + simp only [jarlskogℂCKM, phaseShiftApply.ub, phaseShiftApply.us, phaseShiftApply.cb, + phaseShiftApply.cs, exp_add, _root_.map_mul, ← exp_conj, conj_ofReal, conj_I, mul_neg, exp_neg] + field_simp [Complex.exp_ne_zero] /-- The complex jarlskog invariant for an equivalence class of CKM matrices. -/ @[simp] diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean index 63a9f9b0e..f7d2ceb7e 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean @@ -72,9 +72,8 @@ def δ₁₃ (V : Quotient CKMMatrixSetoid) : ℝ := section sines /-- For a CKM matrix `sin θ₁₂` is non-negative. -/ -lemma S₁₂_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₁₂ V := by - rw [S₁₂] - exact div_nonneg (VAbs_ge_zero 0 1 V) (Real.sqrt_nonneg _) +lemma S₁₂_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₁₂ V := + div_nonneg (VAbs_ge_zero 0 1 V) (Real.sqrt_nonneg _) /-- For a CKM matrix `sin θ₁₃` is non-negative. -/ lemma S₁₃_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₁₃ V := @@ -82,19 +81,16 @@ lemma S₁₃_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₁₃ V := /-- For a CKM matrix `sin θ₂₃` is non-negative. -/ lemma S₂₃_nonneg (V : Quotient CKMMatrixSetoid) : 0 ≤ S₂₃ V := by - by_cases ha : VubAbs V = 1 - · rw [S₂₃, if_pos ha] - exact VAbs_ge_zero 1 0 V - · rw [S₂₃, if_neg ha] - exact div_nonneg (VAbs_ge_zero 1 2 V) (Real.sqrt_nonneg _) + rw [S₂₃] + split + · exact VAbs_ge_zero 1 0 V + · exact div_nonneg (VAbs_ge_zero 1 2 V) (Real.sqrt_nonneg _) /-- For a CKM matrix `sin θ₁₂` is less than or equal to 1. -/ lemma S₁₂_leq_one (V : Quotient CKMMatrixSetoid) : S₁₂ V ≤ 1 := by rw [S₁₂] - apply div_le_one_of_le₀ _ (Real.sqrt_nonneg _) - calc VusAbs V = √(VusAbs V ^ 2) := (Real.sqrt_sq (VAbs_ge_zero 0 1 V)).symm - _ ≤ √(VudAbs V ^ 2 + VusAbs V ^ 2) := - Real.sqrt_le_sqrt (by nlinarith [sq_nonneg (VudAbs V)]) + exact div_le_one_of_le₀ (Real.le_sqrt_of_sq_le (le_add_of_nonneg_left (sq_nonneg _))) + (Real.sqrt_nonneg _) /-- For a CKM matrix `sin θ₁₃` is less than or equal to 1. -/ lemma S₁₃_leq_one (V : Quotient CKMMatrixSetoid) : S₁₃ V ≤ 1 := @@ -102,15 +98,12 @@ lemma S₁₃_leq_one (V : Quotient CKMMatrixSetoid) : S₁₃ V ≤ 1 := /-- For a CKM matrix `sin θ₂₃` is less than or equal to 1. -/ lemma S₂₃_leq_one (V : Quotient CKMMatrixSetoid) : S₂₃ V ≤ 1 := by - by_cases ha : VubAbs V = 1 - · rw [S₂₃, if_pos ha] - exact VAbs_leq_one 1 0 V - · rw [S₂₃, if_neg ha] - apply div_le_one_of_le₀ _ (Real.sqrt_nonneg _) + rw [S₂₃] + split + · exact VAbs_leq_one 1 0 V + · apply div_le_one_of_le₀ _ (Real.sqrt_nonneg _) rw [VudAbs_sq_add_VusAbs_sq, ← VcbAbs_sq_add_VtbAbs_sq] - calc VcbAbs V = √(VcbAbs V ^ 2) := (Real.sqrt_sq (VAbs_ge_zero 1 2 V)).symm - _ ≤ √(VcbAbs V ^ 2 + VtbAbs V ^ 2) := - Real.sqrt_le_sqrt (by nlinarith [sq_nonneg (VtbAbs V)]) + exact Real.le_sqrt_of_sq_le (le_add_of_nonneg_right (sq_nonneg _)) lemma S₁₂_eq_sin_θ₁₂ (V : Quotient CKMMatrixSetoid) : Real.sin (θ₁₂ V) = S₁₂ V := Real.sin_arcsin (le_trans (by simp) (S₁₂_nonneg V)) (S₁₂_leq_one V) @@ -148,8 +141,7 @@ lemma complexAbs_sin_θ₂₃ (V : Quotient CKMMatrixSetoid) : lemma S₁₂_of_Vub_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : S₁₂ V = 0 := by simp [S₁₂, VudAbs_sq_add_VusAbs_sq, ha] -lemma S₁₃_of_Vub_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : S₁₃ V = 1 := by - rw [S₁₃, ha] +lemma S₁₃_of_Vub_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : S₁₃ V = 1 := ha lemma S₂₃_of_Vub_eq_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : S₂₃ V = VcdAbs V := by rw [S₂₃, if_pos ha] @@ -174,40 +166,32 @@ lemma C₂₃_eq_ℂcos_θ₂₃ (V : Quotient CKMMatrixSetoid) : Complex.cos ( lemma complexAbs_cos_θ₁₂ (V : Quotient CKMMatrixSetoid) : norm (Complex.cos (θ₁₂ V)) = cos (θ₁₂ V) := by rw [C₁₂_eq_ℂcos_θ₁₂, Complex.norm_real] - simp only [ofReal_inj] - exact Real.norm_of_nonneg (Real.cos_arcsin_nonneg _) + exact_mod_cast Real.norm_of_nonneg (Real.cos_arcsin_nonneg _) lemma complexAbs_cos_θ₁₃ (V : Quotient CKMMatrixSetoid) : norm (Complex.cos (θ₁₃ V)) = cos (θ₁₃ V) := by rw [C₁₃_eq_ℂcos_θ₁₃, Complex.norm_real] - simp only [ofReal_inj] - exact Real.norm_of_nonneg (Real.cos_arcsin_nonneg _) + exact_mod_cast Real.norm_of_nonneg (Real.cos_arcsin_nonneg _) lemma complexAbs_cos_θ₂₃ (V : Quotient CKMMatrixSetoid) : norm (Complex.cos (θ₂₃ V)) = cos (θ₂₃ V) := by rw [C₂₃_eq_ℂcos_θ₂₃, Complex.norm_real] - simp only [ofReal_inj] - exact Real.norm_of_nonneg (Real.cos_arcsin_nonneg _) + exact_mod_cast Real.norm_of_nonneg (Real.cos_arcsin_nonneg _) lemma S₁₂_sq_add_C₁₂_sq (V : Quotient CKMMatrixSetoid) : S₁₂ V ^ 2 + C₁₂ V ^ 2 = 1 := by - rw [← S₁₂_eq_sin_θ₁₂ V, C₁₂] - exact Real.sin_sq_add_cos_sq (θ₁₂ V) + simp only [← S₁₂_eq_sin_θ₁₂ V, C₁₂, Real.sin_sq_add_cos_sq] lemma S₁₃_sq_add_C₁₃_sq (V : Quotient CKMMatrixSetoid) : S₁₃ V ^ 2 + C₁₃ V ^ 2 = 1 := by - rw [← S₁₃_eq_sin_θ₁₃ V, C₁₃] - exact Real.sin_sq_add_cos_sq (θ₁₃ V) + simp only [← S₁₃_eq_sin_θ₁₃ V, C₁₃, Real.sin_sq_add_cos_sq] lemma S₂₃_sq_add_C₂₃_sq (V : Quotient CKMMatrixSetoid) : S₂₃ V ^ 2 + C₂₃ V ^ 2 = 1 := by - rw [← S₂₃_eq_sin_θ₂₃ V, C₂₃] - exact Real.sin_sq_add_cos_sq (θ₂₃ V) + simp only [← S₂₃_eq_sin_θ₂₃ V, C₂₃, Real.sin_sq_add_cos_sq] lemma C₁₂_of_Vub_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : C₁₂ V = 1 := by - rw [C₁₂, θ₁₂, Real.cos_arcsin, S₁₂_of_Vub_one ha] - simp + simp [C₁₂, θ₁₂, S₁₂_of_Vub_one ha] lemma C₁₃_of_Vub_eq_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : C₁₃ V = 0 := by - rw [C₁₃, θ₁₃, Real.cos_arcsin, S₁₃, ha] - simp + simp [C₁₃, θ₁₃, S₁₃, ha] --rename lemma C₁₂_eq_Vud_div_sqrt {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ 1) : @@ -215,10 +199,7 @@ lemma C₁₂_eq_Vud_div_sqrt {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ rw [C₁₂, θ₁₂, Real.cos_arcsin, S₁₂, div_pow, Real.sq_sqrt] · rw [one_sub_div] · simp only [VudAbs, Fin.isValue, VusAbs, add_sub_cancel_right] - rw [Real.sqrt_div] - · rw [Real.sqrt_sq] - · exact VAbs_ge_zero 0 0 V - exact sq_nonneg (VAbs 0 0 V) + rw [Real.sqrt_div (sq_nonneg (VAbs 0 0 V)), Real.sqrt_sq (VAbs_ge_zero 0 0 V)] exact VAbsub_ne_zero_Vud_Vus_ne_zero ha exact (Left.add_nonneg (sq_nonneg (VAbs 0 0 V)) (sq_nonneg (VAbs 0 1 V))) @@ -232,8 +213,7 @@ lemma C₂₃_of_Vub_ne_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ 1) · rw [VudAbs_sq_add_VusAbs_sq, ← VcbAbs_sq_add_VtbAbs_sq] rw [one_sub_div] · simp only [VcbAbs, Fin.isValue, VtbAbs, add_sub_cancel_left] - rw [Real.sqrt_div (sq_nonneg (VAbs 2 2 V))] - rw [Real.sqrt_sq (VAbs_ge_zero 2 2 V)] + rw [Real.sqrt_div (sq_nonneg (VAbs 2 2 V)), Real.sqrt_sq (VAbs_ge_zero 2 2 V)] · rw [VcbAbs_sq_add_VtbAbs_sq, ← VudAbs_sq_add_VusAbs_sq] exact VAbsub_ne_zero_Vud_Vus_ne_zero ha exact (Left.add_nonneg (sq_nonneg (VAbs 0 0 V)) (sq_nonneg (VAbs 0 1 V))) @@ -245,64 +225,47 @@ section VAbs -- rename to VudAbs_standard_param lemma VudAbs_eq_C₁₂_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VudAbs V = C₁₂ V * C₁₃ V := by by_cases ha : VubAbs V = 1 - · change VAbs 0 0 V = C₁₂ V * C₁₃ V - rw [VAbs_thd_eq_one_fst_eq_zero ha] - rw [C₁₃, θ₁₃, Real.cos_arcsin, S₁₃, ha] - simp only [one_pow, sub_self, Real.sqrt_zero, mul_zero] + · rw [C₁₃_of_Vub_eq_one ha, mul_zero] + exact VAbs_thd_eq_one_fst_eq_zero ha · rw [C₁₂_eq_Vud_div_sqrt ha, C₁₃, θ₁₃, Real.cos_arcsin, S₁₃, ← VudAbs_sq_add_VusAbs_sq, mul_comm] exact (mul_div_cancel₀ (VudAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VusAbs_eq_S₁₂_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VusAbs V = S₁₂ V * C₁₃ V := by - rw [C₁₃, θ₁₃, Real.cos_arcsin, S₁₂, S₁₃, ← VudAbs_sq_add_VusAbs_sq, mul_comm] by_cases ha : VubAbs V = 1 - · have h0 : VudAbs V ^ 2 + VusAbs V ^ 2 = 0 := by - rw [VudAbs_sq_add_VusAbs_sq, ha] - ring - rw [h0] - simp only [Real.sqrt_zero, div_zero, mul_zero] + · rw [C₁₃_of_Vub_eq_one ha, mul_zero] exact VAbs_thd_eq_one_snd_eq_zero ha - · exact (mul_div_cancel₀ (VusAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm + · rw [C₁₃, θ₁₃, Real.cos_arcsin, S₁₂, S₁₃, ← VudAbs_sq_add_VusAbs_sq, mul_comm] + exact (mul_div_cancel₀ (VusAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VubAbs_eq_S₁₃ (V : Quotient CKMMatrixSetoid) : VubAbs V = S₁₃ V := rfl lemma VcbAbs_eq_S₂₃_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VcbAbs V = S₂₃ V * C₁₃ V := by by_cases ha : VubAbs V = 1 - · rw [C₁₃_of_Vub_eq_one ha] - simp only [VcbAbs, Fin.isValue, mul_zero] + · rw [C₁₃_of_Vub_eq_one ha, mul_zero] exact VAbs_fst_col_eq_one_snd_eq_zero ha · rw [S₂₃_of_Vub_ne_one ha, C₁₃_eq_add_sq, mul_comm] exact (mul_div_cancel₀ (VcbAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VtbAbs_eq_C₂₃_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VtbAbs V = C₂₃ V * C₁₃ V := by by_cases ha : VubAbs V = 1 - · rw [C₁₃_of_Vub_eq_one ha] - simp only [VtbAbs, Fin.isValue, mul_zero] + · rw [C₁₃_of_Vub_eq_one ha, mul_zero] exact VAbs_fst_col_eq_one_thd_eq_zero ha · rw [C₂₃_of_Vub_ne_one ha, C₁₃_eq_add_sq, mul_comm] exact (mul_div_cancel₀ (VtbAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VubAbs_of_cos_θ₁₃_zero {V : Quotient CKMMatrixSetoid} (h1 : Real.cos (θ₁₃ V) = 0) : VubAbs V = 1 := by - rw [θ₁₃, Real.cos_arcsin, ← VubAbs_eq_S₁₃, Real.sqrt_eq_zero] at h1 - · have h2 : VubAbs V ^ 2 = 1 := by linear_combination -(1 * h1) - simp only [VubAbs, Fin.isValue, sq_eq_one_iff] at h2 - cases' h2 with h2 h2 - · exact h2 - · have h3 := VAbs_ge_zero 0 2 V - rw [h2] at h3 - simp only [Left.nonneg_neg_iff] at h3 - linarith - · simp only [VubAbs, Fin.isValue, sub_nonneg, sq_le_one_iff_abs_le_one] - rw [_root_.abs_of_nonneg (VAbs_ge_zero 0 2 V)] - exact VAbs_leq_one 0 2 V + rw [VubAbs_eq_S₁₃] + rw [θ₁₃, Real.cos_arcsin, Real.sqrt_eq_zero'] at h1 + refine le_antisymm (S₁₃_leq_one V) ?_ + nlinarith [S₁₃_nonneg V, S₁₃_leq_one V, h1] lemma Vs_zero_iff_cos_sin_zero (V : CKMMatrix) : VudAbs ⟦V⟧ = 0 ∨ VubAbs ⟦V⟧ = 0 ∨ VusAbs ⟦V⟧ = 0 ∨ VcbAbs ⟦V⟧ = 0 ∨ VtbAbs ⟦V⟧ = 0 ↔ Real.cos (θ₁₂ ⟦V⟧) = 0 ∨ Real.cos (θ₁₃ ⟦V⟧) = 0 ∨ Real.cos (θ₂₃ ⟦V⟧) = 0 ∨ Real.sin (θ₁₂ ⟦V⟧) = 0 ∨ Real.sin (θ₁₃ ⟦V⟧) = 0 ∨ Real.sin (θ₂₃ ⟦V⟧) = 0 := by rw [VudAbs_eq_C₁₂_mul_C₁₃, VubAbs_eq_S₁₃, VusAbs_eq_S₁₂_mul_C₁₃, VcbAbs_eq_S₂₃_mul_C₁₃, - VtbAbs_eq_C₂₃_mul_C₁₃] - rw [C₁₂, C₁₃, C₂₃, S₁₂_eq_sin_θ₁₂, S₂₃_eq_sin_θ₂₃, S₁₃_eq_sin_θ₁₃] + VtbAbs_eq_C₂₃_mul_C₁₃, C₁₂, C₁₃, C₂₃, S₁₂_eq_sin_θ₁₂, S₂₃_eq_sin_θ₂₃, S₁₃_eq_sin_θ₁₃] aesop end VAbs @@ -315,10 +278,8 @@ lemma mulExpδ₁₃_on_param_δ₁₃ (V : CKMMatrix) (δ₁₃ : ℝ) : sin (θ₁₂ ⟦V⟧) * cos (θ₁₃ ⟦V⟧) ^ 2 * sin (θ₂₃ ⟦V⟧) * sin (θ₁₃ ⟦V⟧) * cos (θ₁₂ ⟦V⟧) * cos (θ₂₃ ⟦V⟧) * cexp (I * δ₁₃) := by refine mulExpδ₁₃_eq _ _ _ _ ?_ (Real.cos_arcsin_nonneg _) ?_ (Real.cos_arcsin_nonneg _) - · rw [S₁₂_eq_sin_θ₁₂] - exact S₁₂_nonneg _ - · rw [S₂₃_eq_sin_θ₂₃] - exact S₂₃_nonneg _ + · exact le_of_le_of_eq (S₁₂_nonneg _) (S₁₂_eq_sin_θ₁₂ _).symm + · exact le_of_le_of_eq (S₂₃_nonneg _) (S₂₃_eq_sin_θ₂₃ _).symm lemma mulExpδ₁₃_on_param_eq_zero_iff (V : CKMMatrix) (δ₁₃ : ℝ) : mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧ = 0 ↔ @@ -328,11 +289,9 @@ lemma mulExpδ₁₃_on_param_eq_zero_iff (V : CKMMatrix) (δ₁₃ : ℝ) : ← ofReal_inj, ← ofReal_inj, ← ofReal_inj, ← ofReal_inj] simp only [ofReal_mul] rw [← S₁₃_eq_ℂsin_θ₁₃, ← S₁₂_eq_ℂsin_θ₁₂, ← S₂₃_eq_ℂsin_θ₂₃, - ← C₁₃_eq_ℂcos_θ₁₃, ← C₂₃_eq_ℂcos_θ₂₃,← C₁₂_eq_ℂcos_θ₁₂] - rw [mulExpδ₁₃_on_param_δ₁₃] + ← C₁₃_eq_ℂcos_θ₁₃, ← C₂₃_eq_ℂcos_θ₂₃, ← C₁₂_eq_ℂcos_θ₁₂, mulExpδ₁₃_on_param_δ₁₃] simp only [mul_eq_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, pow_eq_zero_iff, - ofReal_zero] - simp only [exp_ne_zero, or_false] + ofReal_zero, exp_ne_zero, or_false] aesop lemma mulExpδ₁₃_on_param_abs (V : CKMMatrix) (δ₁₃ : ℝ) : @@ -349,42 +308,31 @@ lemma mulExpδ₁₃_on_param_ne_zero_arg (V : CKMMatrix) (δ₁₃ : ℝ) (h1 : mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧ ≠ 0) : cexp (arg (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧) * I) = cexp (δ₁₃ * I) := by - have h1a := mulExpδ₁₃_on_param_δ₁₃ V δ₁₃ - have habs := mulExpδ₁₃_on_param_abs V δ₁₃ have h2 : mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧ = norm (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧) * exp (δ₁₃ * I) := by - rw [habs, h1a] + rw [mulExpδ₁₃_on_param_abs V δ₁₃, mulExpδ₁₃_on_param_δ₁₃ V δ₁₃] ring_nf nth_rewrite 1 [← norm_mul_exp_arg_mul_I (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧)] at h2 have habs_ne_zero : (norm (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧) : ℂ) ≠ 0 := by - simp only [ne_eq, ofReal_eq_zero, norm_eq_zero] - exact h1 - rw [← mul_right_inj' habs_ne_zero] - rw [← h2] + simpa only [ne_eq, ofReal_eq_zero, norm_eq_zero] using h1 + rw [← mul_right_inj' habs_ne_zero, ← h2] lemma on_param_cos_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₁₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by - have hS13 := congrArg ofReal (S₁₃_of_Vub_one (VubAbs_of_cos_θ₁₃_zero h)) - simp only [← S₁₃_eq_ℂsin_θ₁₃] at hS13 - have hC12 := congrArg ofReal (C₁₂_of_Vub_one (VubAbs_of_cos_θ₁₃_zero h)) - simp only [← C₁₂_eq_ℂcos_θ₁₂] at hC12 - have hS12 := congrArg ofReal (S₁₂_of_Vub_one (VubAbs_of_cos_θ₁₃_zero h)) - simp only [← S₁₂_eq_ℂsin_θ₁₂] at hS12 + have hub := VubAbs_of_cos_θ₁₃_zero h use 0, 0, 0, δ₁₃, 0, -δ₁₃ - apply CKMMatrix_ext - funext i j + ext i j fin_cases i <;> fin_cases j <;> simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, - Fin.sum_univ_three, ofReal_cos, ofReal_sin, hC12, hS12, hS13, h, exp_neg] + Fin.sum_univ_three, ofReal_cos, ofReal_sin, S₁₃_eq_ℂsin_θ₁₃, C₁₂_eq_ℂcos_θ₁₂, + S₁₂_eq_ℂsin_θ₁₂, S₁₃_of_Vub_one hub, C₁₂_of_Vub_one hub, S₁₂_of_Vub_one hub, h, exp_neg] lemma on_param_cos_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₁₂ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, δ₁₃, δ₁₃, -δ₁₃, 0, - δ₁₃ - have hb := exp_ne_zero (I * δ₁₃) - apply CKMMatrix_ext - funext i j + ext i j fin_cases i <;> fin_cases j <;> simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, Fin.sum_univ_three, h, exp_neg] <;> @@ -393,9 +341,7 @@ lemma on_param_cos_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.c lemma on_param_cos_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₂₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, δ₁₃, 0, 0, 0, - δ₁₃ - have hb := exp_ne_zero (I * δ₁₃) - apply CKMMatrix_ext - funext i j + ext i j fin_cases i <;> fin_cases j <;> simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, Fin.sum_univ_three, h, exp_neg] <;> @@ -404,8 +350,7 @@ lemma on_param_cos_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.c lemma on_param_sin_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.sin (θ₁₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, 0, 0, 0, 0, 0 - apply CKMMatrix_ext - funext i j + ext i j fin_cases i <;> fin_cases j <;> simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, Fin.sum_univ_three, h, exp_neg] @@ -413,9 +358,7 @@ lemma on_param_sin_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.s lemma on_param_sin_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.sin (θ₁₂ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, δ₁₃, δ₁₃, 0, -δ₁₃, - δ₁₃ - have hb := exp_ne_zero (I * δ₁₃) - apply CKMMatrix_ext - funext i j + ext i j fin_cases i <;> fin_cases j <;> simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, Fin.sum_univ_three, h, exp_neg] <;> @@ -424,9 +367,7 @@ lemma on_param_sin_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.s lemma on_param_sin_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.sin (θ₂₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, 0, δ₁₃, 0, 0, - δ₁₃ - have hb := exp_ne_zero (I * δ₁₃) - apply CKMMatrix_ext - funext i j + ext i j fin_cases i <;> fin_cases j <;> simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, Fin.sum_univ_three, h, exp_neg] <;> @@ -452,8 +393,7 @@ lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 ofReal_neg, mul_neg, neg_mul, neg_neg, cons_val', cons_val_zero, empty_val', cons_val_fin_one, cons_val_one] nth_rewrite 1 [← norm_mul_exp_arg_mul_I (V.1 0 2)] - rw [show norm (V.1 0 2) = VubAbs ⟦V⟧ from rfl] - rw [VubAbs_eq_S₁₃, ← S₁₃_eq_sin_θ₁₃ ⟦V⟧] + rw [show norm (V.1 0 2) = VubAbs ⟦V⟧ from rfl, VubAbs_eq_S₁₃, ← S₁₃_eq_sin_θ₁₃ ⟦V⟧] simp only [ofReal_sin, Fin.isValue, mul_eq_mul_left_iff] ring_nf simp only [true_or] @@ -463,9 +403,8 @@ lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 ofReal_cos, ofReal_sin, ofReal_neg, mul_neg, neg_mul, neg_neg, cons_val', empty_val', cons_val_fin_one, cons_val_one, head_cons, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons] - rw [cd_of_fstRowThdColRealCond hb hV] - rw [S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂, C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₁₂_eq_Vud_div_sqrt hb'] - rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_ne_one hb', C₂₃_eq_ℂcos_θ₂₃ ⟦V⟧, + rw [cd_of_fstRowThdColRealCond hb hV, S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂, C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, + C₁₂_eq_Vud_div_sqrt hb', S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_ne_one hb', C₂₃_eq_ℂcos_θ₂₃ ⟦V⟧, C₂₃_of_Vub_ne_one hb', S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃] simp only [VtbAbs, Fin.isValue, VusAbs, neg_mul, VudAbs, VubAbs, VcbAbs, ofReal_div] field_simp @@ -478,9 +417,8 @@ lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 cons_val_zero, empty_val', cons_val_fin_one, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons] rw [C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₂₃_eq_ℂcos_θ₂₃ ⟦V⟧, S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, - S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧] - rw [C₁₂_eq_Vud_div_sqrt hb', C₂₃_of_Vub_ne_one hb', S₁₂, S₁₃, S₂₃_of_Vub_ne_one hb'] - rw [cs_of_fstRowThdColRealCond hb hV] + S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, C₁₂_eq_Vud_div_sqrt hb', C₂₃_of_Vub_ne_one hb', + S₁₂, S₁₃, S₂₃_of_Vub_ne_one hb', cs_of_fstRowThdColRealCond hb hV] simp only [VtbAbs, Fin.isValue, VudAbs, VusAbs, VubAbs, neg_mul, VcbAbs, ofReal_div] field_simp conv_rhs => rw [sq, h1] @@ -493,9 +431,7 @@ lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 lemma eq_standParam_of_ubOnePhaseCond {V : CKMMatrix} (hV : ubOnePhaseCond V) : V = standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by have h1 : VubAbs ⟦V⟧ = 1 := by - simp only [VubAbs, VAbs, VAbs', Fin.isValue, Quotient.lift_mk] - rw [hV.2.2.2.1] - exact norm_one + simp only [VubAbs, VAbs, VAbs', Fin.isValue, Quotient.lift_mk, hV.2.2.2.1, norm_one] refine eq_rows V ?_ ?_ hV.2.2.2.2.1 · funext i fin_cases i @@ -525,21 +461,17 @@ lemma eq_standParam_of_ubOnePhaseCond {V : CKMMatrix} (hV : ubOnePhaseCond V) : ofReal_cos, ofReal_sin, ofReal_zero, mul_zero, exp_zero, mul_one, neg_mul, cons_val', empty_val', cons_val_fin_one, cons_val_one, head_cons, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons] - rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_eq_one h1] - rw [S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂_of_Vub_one h1] - rw [C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₁₂_of_Vub_one h1] - rw [S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃_of_Vub_one h1] - rw [hV.2.2.2.2.2.1] + rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_eq_one h1, S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂_of_Vub_one h1, + C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₁₂_of_Vub_one h1, S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃_of_Vub_one h1, + hV.2.2.2.2.2.1] simp only [VcdAbs, Fin.isValue, ofReal_zero, zero_mul, neg_zero, ofReal_one, mul_one, one_mul, zero_sub] · simp only [cRow, Fin.isValue, Fin.mk_one, cons_val_one, head_cons, standParam, standParamAsMatrix, ofReal_cos, ofReal_sin, ofReal_zero, mul_zero, exp_zero, mul_one, neg_mul, cons_val', cons_val_zero, empty_val', cons_val_fin_one, cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons] - rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_eq_one h1] - rw [S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂_of_Vub_one h1] - rw [C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₁₂_of_Vub_one h1] - rw [S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃_of_Vub_one h1] + rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_eq_one h1, S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂_of_Vub_one h1, + C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₁₂_of_Vub_one h1, S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃_of_Vub_one h1] simp only [Fin.isValue, ofReal_one, one_mul, ofReal_zero, mul_one, VcdAbs, zero_mul, sub_zero] have h3 : (Real.cos (θ₂₃ ⟦V⟧) : ℂ) = √(1 - S₂₃ ⟦V⟧ ^ 2) := by rw [θ₂₃, Real.cos_arcsin] @@ -563,8 +495,7 @@ theorem exists_δ₁₃ (V : CKMMatrix) : have hU' := eq_standParam_of_fstRowThdColRealCond haU hU.2 rw [hU'] at hU use (- arg ([U]ub)) - rw [← hUV] - exact hU.1 + exact hUV ▸ hU.1 · have haU : ¬ ([U]ud ≠ 0 ∨ [U]us ≠ 0) := by rw [ud_us_ne_zero_iff_ub_ne_one] at ha ⊢ rwa [show norm [U]ub = VubAbs ⟦U⟧ from rfl, hUV] diff --git a/Physlib/Particles/NeutrinoPhysics/Basic.lean b/Physlib/Particles/NeutrinoPhysics/Basic.lean index 0d0295632..3f96652fb 100644 --- a/Physlib/Particles/NeutrinoPhysics/Basic.lean +++ b/Physlib/Particles/NeutrinoPhysics/Basic.lean @@ -31,30 +31,28 @@ def diagPhase (θ : Fin 3 → ℝ) : Matrix (Fin 3) (Fin 3) ℂ := lemma diagPhase_zero: diagPhase (fun _ : Fin 3 => 0) = 1 := by ext i j - fin_cases i <;> fin_cases j <;> simp [] + simp [Matrix.one_apply] /-- lemma stating that diagPhase with θ = 0 is equal to diagPhase with all zero phases -/ @[simp] lemma diagPhase_zero_eq : diagPhase 0 = diagPhase (fun _ : Fin 3 => 0) := by ext i j - simp [diagPhase] + simp /-- lemma stating that the Hermitian conjugate of diagPhase diag(+iθ_i) is just diagPhase with entries diag(-iθ_i) -/ @[simp] lemma diagPhase_star (θ : Fin 3 → ℝ) : (diagPhase θ)ᴴ = diagPhase (- θ) := by - ext i j - fin_cases i <;> fin_cases j <;> - simp [diagPhase, Matrix.conjTranspose_apply, ← exp_conj] + show (Matrix.diagonal _)ᴴ = Matrix.diagonal _ + simp [Matrix.diagonal_conjTranspose, ← exp_conj] /-- lemma stating that multiplying two phase matrices is equivalent to adding the phases -/ @[simp] lemma diagPhase_mul (θ φ : Fin 3 → ℝ) : diagPhase θ * diagPhase φ = diagPhase (θ + φ) := by - ext i j - fin_cases i <;> fin_cases j <;> - simp [diagPhase, Matrix.mul_apply, ← exp_add, mul_add] + show Matrix.diagonal _ * Matrix.diagonal _ = Matrix.diagonal _ + simp [Matrix.diagonal_mul_diagonal, ← exp_add, mul_add] /-- diagonal phase matrix diag(iθ_i) is part of the unitary group -/ def diagPhase_unitary (θ : Fin 3 → ℝ) : unitaryGroup (Fin 3) ℂ := @@ -99,31 +97,20 @@ def PMNS_dirac_equivalence (U V : unitaryGroup (Fin 3) ℂ) : Prop := lemma PMNS_dirac_equivalence_refl : ∀ U : unitaryGroup (Fin 3) ℂ, PMNS_dirac_equivalence U U := by intro U - use (fun _ : Fin 3 => 0), (fun _ : Fin 3 => 0) - simp [diagPhase_zero] + exact ⟨0, 0, by simp⟩ /-- The relation `PMNS_dirac_equivalence` is symmetric. -/ lemma PMNS_dirac_equivalence_symm : ∀ U V : unitaryGroup (Fin 3) ℂ, PMNS_dirac_equivalence U V → PMNS_dirac_equivalence V U := by - intros U V h - rcases h with ⟨θ, φ, h'⟩ - use -θ, -φ - rw [h'] - rw [← mul_assoc, mul_assoc] - simp [diagPhase_mul] - rw [← mul_assoc] - simp [diagPhase_mul] + rintro U V ⟨θ, φ, h'⟩ + refine ⟨-θ, -φ, ?_⟩ + simp only [h', ← mul_assoc, diagPhase_mul] + simp [mul_assoc, diagPhase_mul, add_neg_cancel, neg_add_cancel] /-- The relation `PMNS_dirac_equivalence` is transitive. -/ lemma PMNS_dirac_equivalence_trans {U V W : unitaryGroup (Fin 3) ℂ} : PMNS_dirac_equivalence U V → PMNS_dirac_equivalence V W → PMNS_dirac_equivalence U W := by - intros h1 h2 - rcases h1 with ⟨θ1, φ1, hUV⟩ - rcases h2 with ⟨θ2, φ2, hVW⟩ - use (θ1 + θ2), (φ1 + φ2) - rw [hUV, hVW] - rw [← mul_assoc, mul_assoc] - simp [diagPhase_mul] - rw [← mul_assoc] - simp [diagPhase_mul] - simp [add_comm] + rintro ⟨θ1, φ1, hUV⟩ ⟨θ2, φ2, hVW⟩ + refine ⟨θ1 + θ2, φ1 + φ2, ?_⟩ + simp only [hUV, hVW, ← mul_assoc, diagPhase_mul] + simp [mul_assoc, diagPhase_mul, add_comm] diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean index 629f35c78..44a8d0643 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean @@ -34,7 +34,7 @@ lemma E_zero_iff_Q_zero {S : (SMNoGrav 1).Sols} : Q S.val (0 : Fin 1) = 0 ↔ have hS' := congrArg (fun S => S.val) (linearParameters.bijection.right_inv S.1.1) change S'.asCharges = S.val at hS' rw [← hS'] at hC - exact Iff.intro (fun hQ => S'.cubic_zero_Q'_zero hC hQ) (fun hE => S'.cubic_zero_E'_zero hC hE) + exact ⟨S'.cubic_zero_Q'_zero hC, S'.cubic_zero_E'_zero hC⟩ /-- For a set of 1-family SM charges satisfying all ACCs except the gravitational, if the `Q` charge is zero then the charges satisfy the gravitational ACCs. -/ @@ -44,34 +44,31 @@ lemma accGrav_Q_zero {S : (SMNoGrav 1).Sols} (hQ : Q S.val (0 : Fin 1) = 0) : have hE := E_zero_iff_Q_zero.mp hQ simp_all only [toSpecies_apply_eq, Fin.isValue, sum_SMSpecies_numberCharges_one, LinearMap.coe_mk, AddHom.coe_mk] - erw [hQ, hE] have h1 := SU2Sol S.1.1 have h2 := SU3Sol S.1.1 simp only [accSU2, toSpecies_apply_eq, Fin.isValue, sum_SMSpecies_numberCharges_one, LinearMap.coe_mk, AddHom.coe_mk, accSU3] at h1 h2 - erw [hQ] at h1 h2 - simp_all - linear_combination 3 * h2 + erw [hQ] at h1 h2 ⊢ + erw [hE] + linear_combination 2 * h1 + 3 * h2 /-- For a set of 1-family SM charges satisfying all ACCs except the gravitational, if the `Q` charge is not zero then the charges satisfy the gravitational ACCs. -/ lemma accGrav_Q_ne_zero {S : (SMNoGrav 1).Sols} (hQ : Q S.val (0 : Fin 1) ≠ 0) : accGrav S.val = 0 := by have hE := E_zero_iff_Q_zero.mpr.mt hQ - let S' := linearParametersQENeqZero.bijection.symm ⟨S.1.1, And.intro hQ hE⟩ + let S' := linearParametersQENeqZero.bijection.symm ⟨S.1.1, hQ, hE⟩ have hC := cubeSol S have hS' := congrArg (fun S => S.val.val) - (linearParametersQENeqZero.bijection.right_inv ⟨S.1.1, And.intro hQ hE⟩) + (linearParametersQENeqZero.bijection.right_inv ⟨S.1.1, hQ, hE⟩) change _ = S.val at hS' rw [← hS'] at hC ⊢ exact S'.grav_of_cubic hC /-- Any solution to the 1-family ACCs without gravity satisfies the gravitational ACC. -/ theorem accGravSatisfied {S : (SMNoGrav 1).Sols} : - accGrav S.val = 0 := by - by_cases hQ : Q S.val (0 : Fin 1)= 0 - · exact accGrav_Q_zero hQ - · exact accGrav_Q_ne_zero hQ + accGrav S.val = 0 := + (em _).elim accGrav_Q_zero accGrav_Q_ne_zero end One end SMNoGrav diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean index c1ca3a943..0c3267d4d 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean @@ -76,8 +76,7 @@ lemma toSpecies_sum_invariant (m : ℕ) (f : PermGroup n) (S : (SMCharges n).Cha ∑ i, ((fun a => a ^ m) ∘ toSpecies j (repCharges f S)) i = ∑ i, ((fun a => a ^ m) ∘ toSpecies j S) i := by rw [repCharges_toSpecies] - exact Fintype.sum_equiv (f⁻¹ j) (fun x => ((fun a => a ^ m) ∘ (toSpecies j) S ∘ ⇑(f⁻¹ j)) x) - (fun x => ((fun a => a ^ m) ∘ (toSpecies j) S) x) (congrFun rfl) + exact Equiv.sum_comp (f⁻¹ j) ((fun a => a ^ m) ∘ toSpecies j S) /-- The gravitational anomaly equations is invariant under family permutations. -/ lemma accGrav_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : @@ -110,6 +109,6 @@ lemma accQuad_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : /-- The cubic anomaly equation is invariant under family permutations. -/ lemma accCube_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : accCube (repCharges f S) = accCube S := - accCube_ext (fun j => toSpecies_sum_invariant 3 f S j) + accCube_ext (toSpecies_sum_invariant 3 f S) end SM diff --git a/Physlib/Particles/StandardModel/Basic.lean b/Physlib/Particles/StandardModel/Basic.lean index 18c72a2fe..589bcae80 100644 --- a/Physlib/Particles/StandardModel/Basic.lean +++ b/Physlib/Particles/StandardModel/Basic.lean @@ -57,11 +57,8 @@ def toU1 : GaugeGroupI →* unitary ℂ where @[ext] lemma ext {g g' : GaugeGroupI} (hSU3 : toSU3 g = toSU3 g') - (hSU2 : toSU2 g = toSU2 g') (hU1 : toU1 g = toU1 g') : g = g' := by - rcases g with ⟨g1, g2, g3⟩ - cases g' - simp only [toSU3, toSU2, toU1] at hSU3 hSU2 hU1 - simp_all + (hSU2 : toSU2 g = toSU2 g') (hU1 : toU1 g = toU1 g') : g = g' := + Prod.ext hSU3 (Prod.ext hSU2 hU1) instance : Star GaugeGroupI where star g := (star g.1, star g.2.1, star g.2.2) @@ -209,18 +206,8 @@ lemma gaugeGroupℤ₆OfRoot_mem_center (α : rootsOfUnity 6 ℂ) : gaugeGroupℤ₆OfRoot α ∈ Subgroup.center GaugeGroupI := by rw [Subgroup.mem_center_iff] intro g - apply GaugeGroupI.ext - · change GaugeGroupI.toSU3 g * gaugeGroupℤ₆SU3OfRoot α = - gaugeGroupℤ₆SU3OfRoot α * GaugeGroupI.toSU3 g - ext i j - simp [gaugeGroupℤ₆SU3OfRoot, Matrix.scalar_apply, mul_comm] - · change GaugeGroupI.toSU2 g * gaugeGroupℤ₆SU2OfRoot α = - gaugeGroupℤ₆SU2OfRoot α * GaugeGroupI.toSU2 g - ext i j - simp [gaugeGroupℤ₆SU2OfRoot, Matrix.scalar_apply, mul_comm] - · change GaugeGroupI.toU1 g * gaugeGroupℤ₆UnitaryOfRoot α = - gaugeGroupℤ₆UnitaryOfRoot α * GaugeGroupI.toU1 g - exact mul_comm _ _ + refine GaugeGroupI.ext ?_ ?_ (mul_comm _ _) <;> ext i j <;> + simp [map_mul, gaugeGroupℤ₆SU3OfRoot, gaugeGroupℤ₆SU2OfRoot, Matrix.scalar_apply, mul_comm] /-- The homomorphism from sixth roots of unity to `GaugeGroupI`. -/ noncomputable def gaugeGroupℤ₆Hom : rootsOfUnity 6 ℂ →* GaugeGroupI where @@ -289,20 +276,13 @@ lemma mem_gaugeGroupℤ₆SubGroup_iff (g : GaugeGroupI) : lemma gaugeGroupℤ₆SubGroup_le_center : gaugeGroupℤ₆SubGroup ≤ Subgroup.center GaugeGroupI := by - intro g hg - rw [mem_gaugeGroupℤ₆SubGroup_iff] at hg - rcases hg with ⟨α, rfl⟩ + rintro g ⟨α, rfl⟩ exact gaugeGroupℤ₆OfRoot_mem_center α instance gaugeGroupℤ₆SubGroup_normal : gaugeGroupℤ₆SubGroup.Normal where conj_mem n hn g := by - have hn_center : n ∈ Subgroup.center GaugeGroupI := gaugeGroupℤ₆SubGroup_le_center hn - have hcomm : g * n = n * g := (Subgroup.mem_center_iff.mp hn_center) g - have hconj : g * n * g⁻¹ = n := by - calc - g * n * g⁻¹ = n * g * g⁻¹ := by rw [hcomm] - _ = n := by simp [mul_assoc] - simpa [hconj] using hn + rwa [Subgroup.mem_center_iff.mp (gaugeGroupℤ₆SubGroup_le_center hn) g, + mul_inv_cancel_right] /-- The smallest possible gauge group of the Standard Model, i.e., the quotient of `GaugeGroupI` by the ℤ₆-subgroup `gaugeGroupℤ₆SubGroup`. @@ -323,10 +303,8 @@ noncomputable def mk : GaugeGroupI →* GaugeGroupℤ₆ := @[simp] lemma mk_gaugeGroupℤ₆OfRoot (α : rootsOfUnity 6 ℂ) : - mk (gaugeGroupℤ₆OfRoot α) = 1 := by - change ((gaugeGroupℤ₆OfRoot α : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₆SubGroup) = 1 - rw [QuotientGroup.eq_one_iff] - exact gaugeGroupℤ₆OfRoot_mem α + mk (gaugeGroupℤ₆OfRoot α) = 1 := + (QuotientGroup.eq_one_iff _).mpr (gaugeGroupℤ₆OfRoot_mem α) end GaugeGroupℤ₆ @@ -405,27 +383,17 @@ lemma mem_gaugeGroupℤ₂SubGroup_iff (g : GaugeGroupI) : lemma gaugeGroupℤ₂SubGroup_le_gaugeGroupℤ₆SubGroup : gaugeGroupℤ₂SubGroup ≤ gaugeGroupℤ₆SubGroup := by - intro g hg - rw [mem_gaugeGroupℤ₂SubGroup_iff] at hg - rcases hg with ⟨α, rfl⟩ + rintro g ⟨α, rfl⟩ exact gaugeGroupℤ₆OfRoot_mem (gaugeGroupℤ₂RootToℤ₆Root α) lemma gaugeGroupℤ₂SubGroup_le_center : - gaugeGroupℤ₂SubGroup ≤ Subgroup.center GaugeGroupI := by - intro g hg - rw [mem_gaugeGroupℤ₂SubGroup_iff] at hg - rcases hg with ⟨α, rfl⟩ - exact gaugeGroupℤ₂OfRoot_mem_center α + gaugeGroupℤ₂SubGroup ≤ Subgroup.center GaugeGroupI := + gaugeGroupℤ₂SubGroup_le_gaugeGroupℤ₆SubGroup.trans gaugeGroupℤ₆SubGroup_le_center instance gaugeGroupℤ₂SubGroup_normal : gaugeGroupℤ₂SubGroup.Normal where conj_mem n hn g := by - have hn_center : n ∈ Subgroup.center GaugeGroupI := gaugeGroupℤ₂SubGroup_le_center hn - have hcomm : g * n = n * g := (Subgroup.mem_center_iff.mp hn_center) g - have hconj : g * n * g⁻¹ = n := by - calc - g * n * g⁻¹ = n * g * g⁻¹ := by rw [hcomm] - _ = n := by simp [mul_assoc] - simpa [hconj] using hn + rwa [Subgroup.mem_center_iff.mp (gaugeGroupℤ₂SubGroup_le_center hn) g, + mul_inv_cancel_right] /-- The gauge group of the Standard Model with a ℤ₂ quotient, i.e., the quotient of `GaugeGroupI` by the ℤ₂-subgroup `gaugeGroupℤ₂SubGroup`. @@ -446,10 +414,8 @@ noncomputable def mk : GaugeGroupI →* GaugeGroupℤ₂ := @[simp] lemma mk_gaugeGroupℤ₂OfRoot (α : rootsOfUnity 2 ℂ) : - mk (gaugeGroupℤ₂OfRoot α) = 1 := by - change ((gaugeGroupℤ₂OfRoot α : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₂SubGroup) = 1 - rw [QuotientGroup.eq_one_iff] - exact gaugeGroupℤ₂OfRoot_mem α + mk (gaugeGroupℤ₂OfRoot α) = 1 := + (QuotientGroup.eq_one_iff _).mpr (gaugeGroupℤ₂OfRoot_mem α) end GaugeGroupℤ₂ @@ -528,27 +494,17 @@ lemma mem_gaugeGroupℤ₃SubGroup_iff (g : GaugeGroupI) : lemma gaugeGroupℤ₃SubGroup_le_gaugeGroupℤ₆SubGroup : gaugeGroupℤ₃SubGroup ≤ gaugeGroupℤ₆SubGroup := by - intro g hg - rw [mem_gaugeGroupℤ₃SubGroup_iff] at hg - rcases hg with ⟨α, rfl⟩ + rintro g ⟨α, rfl⟩ exact gaugeGroupℤ₆OfRoot_mem (gaugeGroupℤ₃RootToℤ₆Root α) lemma gaugeGroupℤ₃SubGroup_le_center : - gaugeGroupℤ₃SubGroup ≤ Subgroup.center GaugeGroupI := by - intro g hg - rw [mem_gaugeGroupℤ₃SubGroup_iff] at hg - rcases hg with ⟨α, rfl⟩ - exact gaugeGroupℤ₃OfRoot_mem_center α + gaugeGroupℤ₃SubGroup ≤ Subgroup.center GaugeGroupI := + gaugeGroupℤ₃SubGroup_le_gaugeGroupℤ₆SubGroup.trans gaugeGroupℤ₆SubGroup_le_center instance gaugeGroupℤ₃SubGroup_normal : gaugeGroupℤ₃SubGroup.Normal where conj_mem n hn g := by - have hn_center : n ∈ Subgroup.center GaugeGroupI := gaugeGroupℤ₃SubGroup_le_center hn - have hcomm : g * n = n * g := (Subgroup.mem_center_iff.mp hn_center) g - have hconj : g * n * g⁻¹ = n := by - calc - g * n * g⁻¹ = n * g * g⁻¹ := by rw [hcomm] - _ = n := by simp [mul_assoc] - simpa [hconj] using hn + rwa [Subgroup.mem_center_iff.mp (gaugeGroupℤ₃SubGroup_le_center hn) g, + mul_inv_cancel_right] /-- The gauge group of the Standard Model with a ℤ₃-quotient, i.e., the quotient of `GaugeGroupI` by the ℤ₃-subgroup `gaugeGroupℤ₃SubGroup`. @@ -569,10 +525,8 @@ noncomputable def mk : GaugeGroupI →* GaugeGroupℤ₃ := @[simp] lemma mk_gaugeGroupℤ₃OfRoot (α : rootsOfUnity 3 ℂ) : - mk (gaugeGroupℤ₃OfRoot α) = 1 := by - change ((gaugeGroupℤ₃OfRoot α : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₃SubGroup) = 1 - rw [QuotientGroup.eq_one_iff] - exact gaugeGroupℤ₃OfRoot_mem α + mk (gaugeGroupℤ₃OfRoot α) = 1 := + (QuotientGroup.eq_one_iff _).mpr (gaugeGroupℤ₃OfRoot_mem α) end GaugeGroupℤ₃ @@ -628,10 +582,7 @@ lemma subgroup_le_center (q : GaugeGroupQuot) : · exact gaugeGroupℤ₆SubGroup_le_center · exact gaugeGroupℤ₂SubGroup_le_center · exact gaugeGroupℤ₃SubGroup_le_center - · intro g hg - change g ∈ (⊥ : Subgroup GaugeGroupI) at hg - rw [Subgroup.mem_bot] at hg - simp [hg] + · exact bot_le /-- The subgroup attached to a gauge-group quotient choice is normal in `GaugeGroupI`. -/ instance subgroup_normal (q : GaugeGroupQuot) : (subgroup q).Normal := by @@ -639,8 +590,7 @@ instance subgroup_normal (q : GaugeGroupQuot) : (subgroup q).Normal := by · exact gaugeGroupℤ₆SubGroup_normal · exact gaugeGroupℤ₂SubGroup_normal · exact gaugeGroupℤ₃SubGroup_normal - · change (⊥ : Subgroup GaugeGroupI).Normal - infer_instance + · exact Subgroup.normal_bot /-- The quotient map from `GaugeGroupI` to the gauge group selected by a quotient choice. -/ noncomputable def quotientMap (q : GaugeGroupQuot) : GaugeGroupI →* GaugeGroup q := @@ -673,34 +623,16 @@ lemma quotientMap_ℤ₃_gaugeGroupℤ₃OfRoot (α : rootsOfUnity 3 ℂ) : lemma mem_subgroup_iff_quotientMap_eq_one (q : GaugeGroupQuot) (g : GaugeGroupI) : g ∈ subgroup q ↔ quotientMap q g = 1 := by cases q - · change g ∈ gaugeGroupℤ₆SubGroup ↔ - ((g : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₆SubGroup) = 1 - exact (QuotientGroup.eq_one_iff g).symm - · change g ∈ gaugeGroupℤ₂SubGroup ↔ - ((g : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₂SubGroup) = 1 - exact (QuotientGroup.eq_one_iff g).symm - · change g ∈ gaugeGroupℤ₃SubGroup ↔ - ((g : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₃SubGroup) = 1 - exact (QuotientGroup.eq_one_iff g).symm - · change g ∈ (⊥ : Subgroup GaugeGroupI) ↔ (MonoidHom.id GaugeGroupI) g = 1 - simp + case I => exact Subgroup.mem_bot + all_goals exact (QuotientGroup.eq_one_iff g).symm /-- Two representatives have the same image under the selected quotient map exactly when their quotient lies in the subgroup selected by the quotient choice. -/ lemma quotientMap_eq_iff (q : GaugeGroupQuot) (g h : GaugeGroupI) : quotientMap q g = quotientMap q h ↔ g / h ∈ subgroup q := by cases q - · change ((g : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₆SubGroup) = - ((h : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₆SubGroup) ↔ g / h ∈ gaugeGroupℤ₆SubGroup - exact QuotientGroup.eq_iff_div_mem - · change ((g : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₂SubGroup) = - ((h : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₂SubGroup) ↔ g / h ∈ gaugeGroupℤ₂SubGroup - exact QuotientGroup.eq_iff_div_mem - · change ((g : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₃SubGroup) = - ((h : GaugeGroupI) : GaugeGroupI ⧸ gaugeGroupℤ₃SubGroup) ↔ g / h ∈ gaugeGroupℤ₃SubGroup - exact QuotientGroup.eq_iff_div_mem - · change g = h ↔ g / h ∈ (⊥ : Subgroup GaugeGroupI) - rw [Subgroup.mem_bot, div_eq_one] + case I => exact (Subgroup.mem_bot.trans div_eq_one).symm + all_goals exact QuotientGroup.eq_iff_div_mem end GaugeGroupQuot diff --git a/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean b/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean index 5a647eab3..011cdfca8 100644 --- a/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean +++ b/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean @@ -118,7 +118,7 @@ def toFin2ℂ : HiggsVec →L[ℝ] (Fin 2 → ℂ) where /-- The map `toFin2ℂ` is smooth. -/ lemma smooth_toFin2ℂ : ContMDiff 𝓘(ℝ, HiggsVec) 𝓘(ℝ, Fin 2 → ℂ) ⊤ toFin2ℂ := - ContinuousLinearMap.contMDiff toFin2ℂ + toFin2ℂ.contMDiff /-! @@ -148,7 +148,7 @@ def ofReal (a : ℝ) : HiggsVec := @[simp] lemma ofReal_normSq {a : ℝ} (ha : 0 ≤ a) : ‖ofReal a‖ ^ 2 = a := by - simp [ofReal, PiLp.norm_sq_eq_of_L2, Fin.sum_univ_two, Real.sq_sqrt ha] + simp [ofReal, PiLp.norm_sq_eq_of_L2, Real.sq_sqrt ha] /-! @@ -182,29 +182,17 @@ lemma gaugeGroupI_smul_eq_U1_smul_SU2 (g : StandardModel.GaugeGroupI) (φ : Higg instance : MulAction StandardModel.GaugeGroupI HiggsVec where one_smul φ := by simp [gaugeGroupI_smul_eq] mul_smul g₁ g₂ φ := by - rw [gaugeGroupI_smul_eq, gaugeGroupI_smul_eq, gaugeGroupI_smul_eq_U1_mul_SU2] - rw [mulVec_smul, mulVec_smul, smul_smul, mulVec_mulVec] - congr - simp [mul_pow] + simp [gaugeGroupI_smul_eq, mulVec_smul, smul_smul, mulVec_mulVec, mul_pow] instance : DistribMulAction StandardModel.GaugeGroupI HiggsVec where - smul_zero g := by - rw [gaugeGroupI_smul_eq_U1_smul_SU2] - simp - smul_add g φ ψ := by - rw [gaugeGroupI_smul_eq_U1_smul_SU2] - simp [mulVec_add] - simp [← gaugeGroupI_smul_eq_U1_smul_SU2] + smul_zero g := by simp [gaugeGroupI_smul_eq_U1_smul_SU2] + smul_add g φ ψ := by simp [gaugeGroupI_smul_eq_U1_smul_SU2, mulVec_add] instance : SMulCommClass ℂ GaugeGroupI HiggsVec where - smul_comm r g φ := by - simp [gaugeGroupI_smul_eq, mulVec_smul] - rw [smul_comm] + smul_comm r g φ := by simp [gaugeGroupI_smul_eq, mulVec_smul, smul_comm r] instance : SMulCommClass ℝ GaugeGroupI HiggsVec where - smul_comm r g φ := by - simp [gaugeGroupI_smul_eq, mulVec_smul] - rw [smul_comm] + smul_comm r g φ := by simp [gaugeGroupI_smul_eq, mulVec_smul, smul_comm r] /-! @@ -218,30 +206,11 @@ open InnerProductSpace @[simp] lemma gaugeGroupI_smul_inner (g : StandardModel.GaugeGroupI) (φ ψ : HiggsVec) : ⟪g • φ, g • ψ⟫_ℂ = ⟪φ, ψ⟫_ℂ := by - calc ⟪g • φ, g • ψ⟫_ℂ - _ = WithLp.ofLp (g • ψ) ⬝ᵥ star (WithLp.ofLp (g • φ)) := by - rw [EuclideanSpace.inner_eq_star_dotProduct] - _ = (g.toSU2.1 *ᵥ (g.toU1 ^ 3 • ψ)) ⬝ᵥ star (g.toSU2.1 *ᵥ (g.toU1 ^ 3 • φ)) := by - rw [gaugeGroupI_smul_eq_U1_mul_SU2, gaugeGroupI_smul_eq_U1_mul_SU2] - _ = (g.toSU2.1 *ᵥ (g.toU1 ^ 3 • ψ)) ⬝ᵥ (star ((g.toU1 ^ 3 • φ)) ᵥ* star (g.toSU2.1)) := by - rw [star_mulVec] - rfl - _ = ((star (g.toSU2.1) * g.toSU2.1) *ᵥ (g.toU1 ^ 3 • ψ)) ⬝ᵥ star ((g.toU1 ^ 3 • φ)) := by - rw [dotProduct_comm, ← Matrix.dotProduct_mulVec, dotProduct_comm, mulVec_mulVec] - rfl - _ = ((g.toU1 ^ 3 • ψ)) ⬝ᵥ star ((g.toU1 ^ 3 • φ)) := by - rw [mem_unitaryGroup_iff'.mp (GaugeGroupI.toSU2 g).2.1] - simp - _ = ((g.toU1 ^ 3 • ψ)) ⬝ᵥ star (g.toU1 ^ 3) • star (φ.toFin2ℂ) := by - congr - ext i - simp only [Pi.star_apply, RCLike.star_def, star_pow, Pi.smul_apply] - change (starRingEnd ℂ) (GaugeGroupI.toU1 g ^ 3 * φ i) = _ - simp - rfl - _ = (ψ ⬝ᵥ star (φ.toFin2ℂ)) := by - rw [dotProduct_smul, WithLp.ofLp_smul, smul_dotProduct, smul_smul, Unitary.star_mul_self, - one_smul] + rw [gaugeGroupI_smul_eq, gaugeGroupI_smul_eq, EuclideanSpace.inner_toLp_toLp, + EuclideanSpace.inner_eq_star_dotProduct, Submonoid.smul_def, Submonoid.smul_def, star_smul, + smul_dotProduct, dotProduct_smul, smul_smul, Unitary.mul_star_self_of_mem (g.toU1 ^ 3).2, + one_smul, star_mulVec, dotProduct_comm, dotProduct_mulVec, vecMul_vecMul, + ← star_eq_conjTranspose, mem_unitaryGroup_iff'.mp g.toSU2.2.1, vecMul_one, dotProduct_comm] @[simp] lemma gaugeGroupI_smul_norm (g : StandardModel.GaugeGroupI) (φ : HiggsVec) : @@ -301,28 +270,24 @@ def toRealGroupElem (φ : HiggsVec) : GaugeGroupI := lemma toRealGroupElem_smul_self (φ : HiggsVec) : (toRealGroupElem φ) • φ = ofReal (‖φ‖ ^ 2) := by by_cases hφ : φ = 0 - · simp [hφ, toRealGroupElem] - ext i - fin_cases i <;> simp [ofReal] + · ext i + fin_cases i <;> simp [hφ, toRealGroupElem, ofReal] rw [gaugeGroupI_smul_eq] have h0' : (‖φ‖ ^ 2 : ℂ) = φ 0 * (starRingEnd ℂ) (φ 0) + φ 1 * (starRingEnd ℂ) (φ 1) := by rw [← ofReal_pow, ← @real_inner_self_eq_norm_sq] simp only [Fin.isValue, mul_conj, PiLp.inner_apply, Complex.inner, ofReal_re, Fin.sum_univ_two, ofReal_add] - simp [toRealGroupElem, hφ] - · simp [GaugeGroupI.toU1, GaugeGroupI.toSU2] - ext i - have hφ : Complex.ofReal ‖φ‖ ≠ 0 := ofReal_inj.mp.mt (norm_ne_zero_iff.mpr hφ) - fin_cases i - · simp [ofReal] - field_simp - rw [h0'] - ring_nf - rfl - · simp [ofReal] - field_simp - change -(φ 1 * φ 0) + φ 0 * φ 1= _ - ring + have hn : Complex.ofReal ‖φ‖ ≠ 0 := ofReal_inj.mp.mt (norm_ne_zero_iff.mpr hφ) + simp [toRealGroupElem, hφ, GaugeGroupI.toU1, GaugeGroupI.toSU2] + ext i + fin_cases i + · simp [ofReal, vecHead, vecTail] + field_simp + rw [h0'] + ring + · simp [ofReal, vecHead, vecTail] + field_simp + ring /-! @@ -341,8 +306,8 @@ lemma mem_orbit_gaugeGroupI_iff (φ : HiggsVec) (ψ : HiggsVec) : · intro h use (toRealGroupElem ψ)⁻¹ * toRealGroupElem (φ) simp only - rw [← smul_smul, toRealGroupElem_smul_self φ, ← h, ← toRealGroupElem_smul_self ψ, smul_smul] - simp + rw [← smul_smul, toRealGroupElem_smul_self φ, ← h, ← toRealGroupElem_smul_self ψ] + exact inv_smul_smul _ ψ /-! @@ -386,19 +351,12 @@ lemma ofU1Subgroup_smul_eq_smul (g : unitary ℂ) (φ : HiggsVec) : star_pow, RCLike.star_def, smul_of, smul_cons, smul_zero, smul_empty, cons_mulVec, cons_dotProduct, zero_mul, dotProduct_of_isEmpty, add_zero, zero_add, empty_mulVec, one_mul, WithLp.toLp.injEq, vecCons_inj, mul_eq_mul_right_iff, and_true] - apply And.intro + refine ⟨?_, Or.inl ?_⟩ · have h0 : g ^ 3 • (starRingEnd ℂ) ↑g ^ 3 = 1 := by - trans (normSq (g ^ 3).1 : ℂ) - · rw [← mul_conj] - simp - rfl - · rw [normSq_eq_norm_sq] - simp + simp only [starRingEnd_apply, Submonoid.smul_def, smul_eq_mul, SubmonoidClass.coe_pow, + ← mul_pow, Unitary.mul_star_self_of_mem g.2, one_pow] simp [h0] - · left - trans (g ^ 3 : ℂ) • (g ^ 3 : ℂ) - · rfl - simp only [smul_eq_mul] + · show (g : ℂ) ^ 3 * (g : ℂ) ^ 3 = (g : ℂ) ^ 6 ring lemma gaugeGroupI_smul_phase_snd (φ : HiggsVec) : @@ -407,11 +365,10 @@ lemma gaugeGroupI_smul_phase_snd (φ : HiggsVec) : (∀ φ1 : HiggsVec, (g • φ1).ofLp 0 = φ1.ofLp 0) ∧ (∀ a : ℝ, g • (!₂[a, 0] : HiggsVec) = (!₂[a, 0] : HiggsVec)) := by let θ := arg (φ 1) - use StandardModel.GaugeGroupI.ofU1Subgroup ⟨Complex.exp (-I * θ / 6), by + refine ⟨StandardModel.GaugeGroupI.ofU1Subgroup ⟨Complex.exp (-I * θ / 6), by simp [Unitary.mem_iff, ← Complex.exp_conj, ← Complex.exp_add, Complex.conj_ofNat] ring_nf - simp⟩ - apply And.intro + simp⟩, ?_, ?_, ?_⟩ · rw [ofU1Subgroup_smul_eq_smul] simp only [Fin.isValue, neg_mul, cons_mulVec, cons_dotProduct, one_mul, zero_mul, dotProduct_of_isEmpty, add_zero, zero_add, empty_mulVec, cons_val_one, cons_val_fin_one] @@ -421,7 +378,6 @@ lemma gaugeGroupI_smul_phase_snd (φ : HiggsVec) : simp [θ] ring_nf simp - apply And.intro · intro φ simp [ofU1Subgroup_smul_eq_smul, vecHead] · intro a @@ -450,20 +406,16 @@ def toRealScalars : HiggsVec →ₗ[ℝ] (Fin 4 → ℝ) where fin_cases i <;> simp lemma toRealScalars_smul_real (a : ℝ) (φ : HiggsVec) : - toRealScalars (a • φ) = a • toRealScalars φ := by - simp [toRealScalars] + toRealScalars (a • φ) = a • toRealScalars φ := map_smul toRealScalars a φ lemma ofReal_toRealScalars (a : ℝ) : toRealScalars (ofReal a) = !₄[Real.sqrt a, 0, 0, 0] := by - simp [ofReal, toRealScalars] funext i - fin_cases i <;> simp + fin_cases i <;> simp [ofReal, toRealScalars] lemma ofReal_toRealScalars_norm (φ : HiggsVec) : toRealScalars (ofReal (‖φ‖ ^ 2)) = !₄[‖φ‖, 0, 0, 0] := by - simp [ofReal, toRealScalars] - funext i - fin_cases i <;> simp + rw [ofReal_toRealScalars, Real.sqrt_sq (norm_nonneg φ)] end HiggsVec @@ -566,11 +518,8 @@ lemma const_apply (φ : HiggsVec) (x : SpaceTime) : const φ x = φ := rfl def toHiggsVec (φ : HiggsField) : SpaceTime → HiggsVec := φ lemma toHiggsVec_smooth (φ : HiggsField) : - ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, HiggsVec) ⊤ φ.toHiggsVec := by - intro x0 - have h1 := φ.contMDiff x0 - rw [Bundle.contMDiffAt_section] at h1 - exact h1 + ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, HiggsVec) ⊤ φ.toHiggsVec := + fun x0 => (Bundle.contMDiffAt_section x0).mp (φ.contMDiff x0) lemma const_toHiggsVec_apply (φ : HiggsField) (x : SpaceTime) : const (φ.toHiggsVec x) x = φ x := rfl @@ -588,31 +537,24 @@ We prove some smoothness properties of the components of a Higgs field. @[fun_prop] lemma contDiff (φ : HiggsField) : - ContDiff ℝ ⊤ φ := by - have h1 := φ.toHiggsVec_smooth - simp_all only [contMDiff_iff_contDiff] - exact h1 + ContDiff ℝ ⊤ φ := + contMDiff_iff_contDiff.mp φ.toHiggsVec_smooth lemma toVec_smooth (φ : HiggsField) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, EuclideanSpace ℂ (Fin 2)) ⊤ φ := φ.toHiggsVec_smooth lemma apply_smooth (φ : HiggsField) : - ∀ i, ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℂ) ⊤ (fun (x : SpaceTime) => (φ x i)) := by - have h1 := φ.contDiff - intro i - refine ContDiff.contMDiff ?_ - simp only - rw [contDiff_piLp] at h1 - exact h1 i + ∀ i, ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℂ) ⊤ (fun (x : SpaceTime) => (φ x i)) := + fun i => ((contDiff_piLp 2).mp φ.contDiff i).contMDiff lemma apply_re_smooth (φ : HiggsField) (i : Fin 2) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℝ) ⊤ (reCLM ∘ (fun (x : SpaceTime) => (φ x i))) := - (ContinuousLinearMap.contMDiff reCLM).comp (φ.apply_smooth i) + reCLM.contMDiff.comp (φ.apply_smooth i) lemma apply_im_smooth (φ : HiggsField) (i : Fin 2) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℝ) ⊤ (imCLM ∘ (fun (x : SpaceTime) => (φ x i))) := - (ContinuousLinearMap.contMDiff imCLM).comp (φ.apply_smooth i) + imCLM.contMDiff.comp (φ.apply_smooth i) /-! @@ -642,22 +584,13 @@ lemma inner_eq_expand (φ1 φ2 : HiggsField) : ((φ1 x 0).re * (φ2 x 0).im + (φ1 x 1).re * (φ2 x 1).im - (φ1 x 0).im * (φ2 x 0).re - (φ1 x 1).im * (φ2 x 1).re)) := by funext x - simp only [inner_apply, PiLp.inner_apply, RCLike.inner_apply, Fin.sum_univ_two, - equivRealProdCLM_symm_apply, ofReal_add, ofReal_mul, ofReal_sub] - rw [RCLike.conj_eq_re_sub_im, RCLike.conj_eq_re_sub_im] - nth_rewrite 1 [← RCLike.re_add_im (φ2 x 0)] - nth_rewrite 1 [← RCLike.re_add_im (φ2 x 1)] - ring_nf - simp only [Fin.isValue, RCLike.re_to_complex, coe_algebraMap, RCLike.I_to_complex, - RCLike.im_to_complex, I_sq, mul_neg, mul_one, neg_mul, sub_neg_eq_add, one_mul] - ring + apply Complex.ext <;> simp [inner_apply, PiLp.inner_apply, equivRealProdCLM_symm_apply] <;> ring /-- Expands the inner product on Higgs fields in terms of complex components of the Higgs fields. -/ lemma inner_expand_conj (φ1 φ2 : HiggsField) (x : SpaceTime) : ⟪φ1, φ2⟫_(SpaceTime → ℂ) x = conj (φ1 x 0) * φ2 x 0 + conj (φ1 x 1) * φ2 x 1 := by - simp [inner_apply, PiLp.inner_apply] - ring + simp [inner_apply, PiLp.inner_apply, mul_comm] /-! @@ -666,9 +599,8 @@ lemma inner_expand_conj (φ1 φ2 : HiggsField) (x : SpaceTime) : -/ lemma inner_symm (φ1 φ2 : HiggsField) : - conj ⟪φ2, φ1⟫_(SpaceTime → ℂ) = ⟪φ1, φ2⟫_(SpaceTime → ℂ) := by - funext x - simp only [inner_apply, Pi.conj_apply, inner_conj_symm] + conj ⟪φ2, φ1⟫_(SpaceTime → ℂ) = ⟪φ1, φ2⟫_(SpaceTime → ℂ) := + funext fun x => inner_conj_symm (φ1 x) (φ2 x) /-! @@ -677,36 +609,30 @@ lemma inner_symm (φ1 φ2 : HiggsField) : -/ lemma inner_add_left (φ1 φ2 φ3 : HiggsField) : - ⟪φ1 + φ2, φ3⟫_(SpaceTime → ℂ) = ⟪φ1, φ3⟫_(SpaceTime → ℂ) + ⟪φ2, φ3⟫_(SpaceTime → ℂ) := by - funext x - simp [inner_apply, _root_.inner_add_left] + ⟪φ1 + φ2, φ3⟫_(SpaceTime → ℂ) = ⟪φ1, φ3⟫_(SpaceTime → ℂ) + ⟪φ2, φ3⟫_(SpaceTime → ℂ) := + funext fun x => _root_.inner_add_left (φ1 x) (φ2 x) (φ3 x) lemma inner_add_right (φ1 φ2 φ3 : HiggsField) : - ⟪φ1, φ2 + φ3⟫_(SpaceTime → ℂ) = ⟪φ1, φ2⟫_(SpaceTime → ℂ) + ⟪φ1, φ3⟫_(SpaceTime → ℂ) := by - funext x - simp [inner_apply, _root_.inner_add_right] + ⟪φ1, φ2 + φ3⟫_(SpaceTime → ℂ) = ⟪φ1, φ2⟫_(SpaceTime → ℂ) + ⟪φ1, φ3⟫_(SpaceTime → ℂ) := + funext fun x => _root_.inner_add_right (φ1 x) (φ2 x) (φ3 x) @[simp] lemma inner_zero_left (φ : HiggsField) : - ⟪0, φ⟫_(SpaceTime → ℂ) = 0 := by - funext x - simp [inner_apply] + ⟪0, φ⟫_(SpaceTime → ℂ) = 0 := + funext fun x => _root_.inner_zero_left (φ x) @[simp] lemma inner_zero_right (φ : HiggsField) : - ⟪φ, 0⟫_(SpaceTime → ℂ) = 0 := by - funext x - simp [inner_apply] + ⟪φ, 0⟫_(SpaceTime → ℂ) = 0 := + funext fun x => _root_.inner_zero_right (φ x) lemma inner_neg_left (φ1 φ2 : HiggsField) : - ⟪-φ1, φ2⟫_(SpaceTime → ℂ) = -⟪φ1, φ2⟫_(SpaceTime → ℂ) := by - funext x - simp [inner_apply] + ⟪-φ1, φ2⟫_(SpaceTime → ℂ) = -⟪φ1, φ2⟫_(SpaceTime → ℂ) := + funext fun x => _root_.inner_neg_left (φ1 x) (φ2 x) lemma inner_neg_right (φ1 φ2 : HiggsField) : - ⟪φ1, -φ2⟫_(SpaceTime → ℂ) = -⟪φ1, φ2⟫_(SpaceTime → ℂ) := by - funext x - simp [inner_apply] + ⟪φ1, -φ2⟫_(SpaceTime → ℂ) = -⟪φ1, φ2⟫_(SpaceTime → ℂ) := + funext fun x => _root_.inner_neg_right (φ1 x) (φ2 x) /-! @@ -715,17 +641,9 @@ lemma inner_neg_right (φ1 φ2 : HiggsField) : -/ lemma inner_smooth (φ1 φ2 : HiggsField) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℂ) ⊤ - ⟪φ1, φ2⟫_(SpaceTime → ℂ) := by - rw [inner_eq_expand] - exact (ContinuousLinearMap.contMDiff (equivRealProdCLM.symm : ℝ × ℝ →L[ℝ] ℂ)).comp $ - (((((φ1.apply_re_smooth 0).smul (φ2.apply_re_smooth 0)).add - ((φ1.apply_re_smooth 1).smul (φ2.apply_re_smooth 1))).add - ((φ1.apply_im_smooth 0).smul (φ2.apply_im_smooth 0))).add - ((φ1.apply_im_smooth 1).smul (φ2.apply_im_smooth 1))).prodMk_space $ - ((((φ1.apply_re_smooth 0).smul (φ2.apply_im_smooth 0)).add - ((φ1.apply_re_smooth 1).smul (φ2.apply_im_smooth 1))).sub - ((φ1.apply_im_smooth 0).smul (φ2.apply_re_smooth 0))).sub - ((φ1.apply_im_smooth 1).smul (φ2.apply_re_smooth 1)) + ⟪φ1, φ2⟫_(SpaceTime → ℂ) := + ContDiff.contMDiff <| + (isBoundedBilinearMap_inner (𝕜 := ℂ)).contDiff.comp (φ1.contDiff.prodMk φ2.contDiff) /-! @@ -754,17 +672,11 @@ scoped[StandardModel.HiggsField] notation "‖" φ1 "‖_H^2" => normSq φ1 lemma inner_self_eq_normSq (φ : HiggsField) (x : SpaceTime) : ⟪φ, φ⟫_(SpaceTime → ℂ) x = ‖φ‖_H^2 x := by - simp only [inner_apply, PiLp.inner_apply, RCLike.inner_apply, Fin.sum_univ_two, Fin.isValue, - normSq, ofReal_pow] - rw [← Complex.ofReal_pow, PiLp.norm_sq_eq_of_L2] - rw [Fin.sum_univ_two, ofReal_add, ofReal_pow] - rw [mul_comm, conj_mul', mul_comm, conj_mul', ofReal_pow] + simp [inner_apply, inner_self_eq_norm_sq_to_K] lemma normSq_eq_inner_self_re (φ : HiggsField) (x : SpaceTime) : φ.normSq x = (⟪φ, φ⟫_(SpaceTime → ℂ) x).re := by - rw [inner_self_eq_normSq] - simp only [normSq, ofReal_pow] - rw [← Complex.ofReal_pow, Complex.ofReal_re] + rw [inner_self_eq_normSq, Complex.ofReal_re] /-- The expansion of the norm squared of into components. -/ lemma normSq_expand (φ : HiggsField) : @@ -778,8 +690,7 @@ lemma normSq_expand (φ : HiggsField) : -/ -lemma normSq_nonneg (φ : HiggsField) (x : SpaceTime) : 0 ≤ ‖φ‖_H^2 x := by - simp [normSq] +lemma normSq_nonneg (φ : HiggsField) (x : SpaceTime) : 0 ≤ ‖φ‖_H^2 x := sq_nonneg _ /-! @@ -800,14 +711,8 @@ lemma normSq_zero : ‖0‖_H^2 = 0 := by /-- The norm squared of the Higgs field is a smooth function on space-time. -/ lemma normSq_smooth (φ : HiggsField) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℝ) ⊤ φ.normSq := by - rw [normSq_expand] - refine ContMDiff.add ?_ ?_ - · simp only [mul_re, conj_re, conj_im, neg_mul, sub_neg_eq_add] - exact ((φ.apply_re_smooth 0).smul (φ.apply_re_smooth 0)).add $ - (φ.apply_im_smooth 0).smul (φ.apply_im_smooth 0) - · simp only [mul_re, conj_re, conj_im, neg_mul, sub_neg_eq_add] - exact ((φ.apply_re_smooth 1).smul (φ.apply_re_smooth 1)).add $ - (φ.apply_im_smooth 1).smul (φ.apply_im_smooth 1) + rw [show φ.normSq = reCLM ∘ ⟪φ, φ⟫_(SpaceTime → ℂ) from funext (normSq_eq_inner_self_re φ)] + exact reCLM.contMDiff.comp (φ.inner_smooth φ) /-! @@ -817,8 +722,7 @@ lemma normSq_smooth (φ : HiggsField) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, @[simp] lemma const_normSq (φ : HiggsVec) (x : SpaceTime) : - ‖const φ‖_H^2 x = ‖φ‖ ^ 2 := by - simp [normSq, const_apply] + ‖const φ‖_H^2 x = ‖φ‖ ^ 2 := by simp /-! diff --git a/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean b/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean index c102110c3..55ac72aa5 100644 --- a/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean +++ b/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean @@ -52,8 +52,7 @@ namespace IsInvariant lemma eq_on_orbits {φ1 φ2 : HiggsVec} {V : EffectivePotential} (h : IsInvariant V) (hφ : φ1 ∈ MulAction.orbit GaugeGroupI φ2) : V φ1 = V φ2 := by - obtain ⟨g, hg⟩ := hφ - rw [← hg] + obtain ⟨g, rfl⟩ := hφ exact h g φ2 /-- An invariant potential is equal on Higgs vectors with identical norms. -/ @@ -65,7 +64,6 @@ lemma factors_through_norm {V : EffectivePotential} (h : IsInvariant V) : ∃ (f : ℝ → ℝ), V = f ∘ norm := by use fun a => V !₂[a, 0] ext φ - simp only [Function.comp_apply] apply h.eq_of_norm_eq conv_rhs => rw [PiLp.norm_eq_of_L2] simp @@ -108,11 +106,9 @@ def termOfMassDim (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) ( lemma termOfMassDim_eq_zero_of_max_lt {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) {m : ℕ} (hm : n < m) (φ : HiggsVec) : termOfMassDim V h m φ = 0 := by - simp only [termOfMassDim] - rw [MvPolynomial.homogeneousComponent_eq_zero] - simp only [map_zero] have h1 := polynomial_totalDegree h - grind + simp only [termOfMassDim] + rw [MvPolynomial.homogeneousComponent_eq_zero _ _ (by omega), map_zero] lemma termOfMassDim_homogeneity {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) (φ : HiggsVec) (t : ℝ) : termOfMassDim V h m (t • φ) = t ^ m * termOfMassDim V h m φ := by @@ -136,19 +132,15 @@ lemma apply_eq_sum_termOfMassDim {V : EffectivePotential} {n : ℕ} (h : HasMaxM symm refine Finset.eventually_constant_sum ?_ ?_ · intro m hm - simp [termOfMassDim] - rw [MvPolynomial.homogeneousComponent_eq_zero _ _ (by grind)] - simp - · have h1 := polynomial_totalDegree h - grind + simp only [termOfMassDim] + rw [MvPolynomial.homogeneousComponent_eq_zero _ _ (by omega), map_zero] + · exact Nat.add_le_add_right (polynomial_totalDegree h) 1 lemma apply_smul_eq_sum_termOfMassDim {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (φ : HiggsVec) (t : ℝ) : V (t • φ) = ∑ m ∈ Finset.range (n + 1), t ^ m * termOfMassDim V h m φ := by rw [apply_eq_sum_termOfMassDim h] - congr - funext m - exact termOfMassDim_homogeneity h m φ t + exact Finset.sum_congr rfl fun m _ => termOfMassDim_homogeneity h m φ t lemma termOfMassDim_isInvariant {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) (hV : IsInvariant V) : IsInvariant (termOfMassDim V h m) := by @@ -169,10 +161,9 @@ lemma termOfMassDim_isInvariant {V : EffectivePotential} {n : ℕ} (h : HasMaxMa rw [← h1 x] exact Finset.sum_congr rfl fun k _ => by ring have hcoeff := congrArg (fun p => p.coeff m) hp - simp only [Polynomial.finsetSum_coeff, Polynomial.coeff_C_mul, Polynomial.coeff_X_pow, + simpa only [Polynomial.finsetSum_coeff, Polynomial.coeff_C_mul, Polynomial.coeff_X_pow, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.mem_range, Nat.lt_succ_iff, hmn, - if_true, Polynomial.coeff_zero] at hcoeff - exact sub_eq_zero.mp hcoeff + if_true, Polynomial.coeff_zero, sub_eq_zero] using hcoeff · rw [termOfMassDim_eq_zero_of_max_lt h (not_le.mp hmn), termOfMassDim_eq_zero_of_max_lt h (not_le.mp hmn)] @@ -187,12 +178,10 @@ lemma termOfMassDim_eq_mul_norm {V : EffectivePotential} {n : ℕ} lemma termOfMassDim_zero_of_odd {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) (hV : IsInvariant V) (φ : HiggsVec) (hodd : Odd m) : termOfMassDim V h m φ = 0 := by - have h1 : termOfMassDim V h m φ = termOfMassDim V h m ((-1 : ℝ) • φ) := by - apply (termOfMassDim_isInvariant h m hV).eq_of_norm_eq - simp + have h1 : termOfMassDim V h m φ = termOfMassDim V h m ((-1 : ℝ) • φ) := + (termOfMassDim_isInvariant h m hV).eq_of_norm_eq (by simp) rw [termOfMassDim_homogeneity h m φ (-1 : ℝ), hodd.neg_one_pow] at h1 - simp only [neg_mul, one_mul] at h1 - grind + linarith /-! @@ -207,23 +196,20 @@ lemma apply_eq_sum_even_termOfMassDim {V : EffectivePotential} {n : ℕ} (h : Ha (Finset.range (n + 1)) Even] have hodd : ∑ m ∈ (Finset.range (n + 1)).filter (fun m => ¬ Even m), termOfMassDim V h m φ = 0 := by - apply Finset.sum_eq_zero - intro m hm + refine Finset.sum_eq_zero fun m hm => ?_ simp only [Finset.mem_filter] at hm exact termOfMassDim_zero_of_odd h m hV φ (Nat.not_even_iff_odd.mp hm.2) rw [hodd, add_zero] - have hinj : ∀ x ∈ Finset.range (n / 2 + 1), ∀ y ∈ Finset.range (n / 2 + 1), - 2 * x = 2 * y → x = y := fun x _ y _ hxy => by omega have hset : (Finset.range (n / 2 + 1)).image (fun k => 2 * k) = (Finset.range (n + 1)).filter Even := by ext a simp only [Finset.mem_image, Finset.mem_range, Finset.mem_filter, Nat.even_iff] constructor · rintro ⟨k, hk, rfl⟩ - exact ⟨by omega, by omega⟩ + omega · rintro ⟨ha, hae⟩ exact ⟨a / 2, by omega, by omega⟩ - rw [← hset, Finset.sum_image hinj] + rw [← hset, Finset.sum_image fun x _ y _ hxy => by omega] lemma apply_eq_sum_even_termOfMassDim_fin {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (hV : IsInvariant V) (φ : HiggsVec) : @@ -236,8 +222,7 @@ lemma apply_eq_sum_norm_pow {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDi ∃ c : Fin (n/2 + 1) → ℝ, V φ = ∑ m, c m • ‖φ‖ ^ (2 * m.1) := by use fun m' => Classical.choose (termOfMassDim_eq_mul_norm h (2 * m'.1) hV φ) rw [apply_eq_sum_even_termOfMassDim_fin h hV φ] - congr 1 - ext m + refine Finset.sum_congr rfl fun m _ => ?_ simpa using Classical.choose_spec (termOfMassDim_eq_mul_norm h (2 * m.1) hV φ) end EffectivePotential diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean index 340c8f26d..01d37a111 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean @@ -31,10 +31,7 @@ namespace MSSMCharges lemma sum_MSSMSpecies_numberCharges_eq_expand [AddCommMonoid M] (f : Fin MSSMSpecies.numberCharges → M) : - ∑ i, f i = f ⟨0, by simp⟩ + f ⟨1, by simp⟩ + f ⟨2, by simp⟩ := by - change ∑ (i : Fin 3), f i = f ⟨0, by simp⟩ + f ⟨1, by simp⟩ + f ⟨2, by simp⟩ - simp only [Fin.sum_univ_three] - rfl + ∑ i, f i = f ⟨0, by simp⟩ + f ⟨1, by simp⟩ + f ⟨2, by simp⟩ := Fin.sum_univ_three f /-- An equivalence between `MSSMCharges.charges` and the space of maps `(Fin 18 ⊕ Fin 2 → ℚ)`. The first 18 factors corresponds to the SM fermions, while the last two @@ -79,9 +76,8 @@ def toSMSpecies (i : Fin 6) : MSSMCharges.Charges →ₗ[ℚ] MSSMSpecies.Charge map_smul' _ _ := by rfl lemma toSMSpecies_toSpecies_inv (i : Fin 6) (f : (Fin 6 → Fin 3 → ℚ) × (Fin 2 → ℚ)) : - (toSMSpecies i) (toSpecies.symm f) = f.1 i := by - change (Prod.fst ∘ toSpecies ∘ toSpecies.symm) _ i= f.1 i - simp + (toSMSpecies i) (toSpecies.symm f) = f.1 i := + congrFun (congrArg Prod.fst (toSpecies.apply_symm_apply f)) i /-- The `Q` charges as a map `Fin 3 → ℚ`. -/ abbrev Q := toSMSpecies 0 @@ -112,17 +108,8 @@ def Hu : MSSMCharges.Charges →ₗ[ℚ] ℚ where lemma charges_eq_toSpecies_eq (S T : MSSMCharges.Charges) : S = T ↔ (∀ i, toSMSpecies i S = toSMSpecies i T) ∧ Hd S = Hd T ∧ Hu S = Hu T := by - refine Iff.intro (fun h => ?_) (fun h => ?_) - · rw [h] - simp only [forall_const, Hd_apply, Fin.reduceFinMk, Fin.isValue, Hu_apply, and_self] - · apply toSpecies.injective - apply Prod.ext - · funext i - exact h.1 i - · funext i - match i with - | 0 => exact h.2.1 - | 1 => exact h.2.2 + refine ⟨fun h => h ▸ ⟨fun _ => rfl, rfl, rfl⟩, fun h => toSpecies.injective ?_⟩ + exact Prod.ext (funext h.1) (funext fun | 0 => h.2.1 | 1 => h.2.2) lemma Hd_toSpecies_inv (f : (Fin 6 → Fin 3 → ℚ) × (Fin 2 → ℚ)) : Hd (toSpecies.symm f) = f.2 0 := by @@ -143,18 +130,12 @@ def accGrav : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (6 * Q S i + 3 * U S i + 3 * D S i + 2 * L S i + E S i + N S i) + 2 * (Hd S + Hu S) map_add' S T := by - repeat rw [map_add] - simp only [ACCSystemCharges.chargesAddCommMonoid_add, toSMSpecies_apply, reduceMul, Fin.isValue, - mul_add, Hd_apply, Fin.reduceFinMk, Hu_apply] - repeat rw [Finset.sum_add_distrib] + simp only [map_add, ACCSystemCharges.chargesAddCommMonoid_add, + sum_MSSMSpecies_numberCharges_eq_expand] ring map_smul' a S := by - repeat rw [(toSMSpecies _).map_smul] - simp_rw [Hd.map_smul, Hu.map_smul] - simp only [HSMul.hSMul, SMul.smul, Fin.isValue, toSMSpecies_apply, reduceMul, Hd_apply, - Fin.reduceFinMk, Hu_apply, eq_ratCast, Rat.cast_eq_id, id_eq] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] + simp only [map_smul, smul_eq_mul, RingHom.id_apply] + simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring /-- Extensionality lemma for `accGrav`. -/ @@ -162,28 +143,19 @@ lemma accGrav_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) (hd : Hd S = Hd T) (hu : Hu S = Hu T) : accGrav S = accGrav T := by - simp only [accGrav, toSMSpecies_apply, Fin.isValue, LinearMap.coe_mk, AddHom.coe_mk] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - simp_all + simp only [accGrav, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, + hj, hd, hu] /-- The anomaly cancellation condition for SU(2) anomaly. -/ def accSU2 : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (3 * Q S i + L S i) + Hd S + Hu S map_add' S T := by - repeat rw [map_add] - simp only [ACCSystemCharges.chargesAddCommMonoid_add, toSMSpecies_apply, reduceMul, Fin.isValue, - mul_add, Hd_apply, Fin.reduceFinMk, Hu_apply] - repeat rw [Finset.sum_add_distrib] + simp only [map_add, ACCSystemCharges.chargesAddCommMonoid_add, + sum_MSSMSpecies_numberCharges_eq_expand] ring map_smul' a S := by - repeat rw [(toSMSpecies _).map_smul] - rw [Hd.map_smul, Hu.map_smul] - simp only [HSMul.hSMul, SMul.smul, Fin.isValue, toSMSpecies_apply, reduceMul, Hd_apply, - Fin.reduceFinMk, Hu_apply, eq_ratCast, Rat.cast_eq_id, id_eq] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - --rw [show Rat.cast a = a from rfl] + simp only [map_smul, smul_eq_mul, RingHom.id_apply] + simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring /-- Extensionality lemma for `accSU2`. -/ @@ -191,56 +163,39 @@ lemma accSU2_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) (hd : Hd S = Hd T) (hu : Hu S = Hu T) : accSU2 S = accSU2 T := by - simp only [accSU2, toSMSpecies_apply, Fin.isValue, LinearMap.coe_mk, AddHom.coe_mk] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - simp_all + simp only [accSU2, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, + hj, hd, hu] /-- The anomaly cancellation condition for SU(3) anomaly. -/ def accSU3 : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (2 * (Q S i) + (U S i) + (D S i)) map_add' S T := by - repeat rw [map_add] - simp only [ACCSystemCharges.chargesAddCommMonoid_add, toSMSpecies_apply, reduceMul, Fin.isValue, - mul_add] - repeat rw [Finset.sum_add_distrib] + simp only [map_add, ACCSystemCharges.chargesAddCommMonoid_add, + sum_MSSMSpecies_numberCharges_eq_expand] ring map_smul' a S := by - repeat rw [(toSMSpecies _).map_smul] - simp only [HSMul.hSMul, SMul.smul, Fin.isValue, toSMSpecies_apply, reduceMul, eq_ratCast, - Rat.cast_eq_id, id_eq] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - --rw [show Rat.cast a = a from rfl] + simp only [map_smul, smul_eq_mul, RingHom.id_apply] + simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring /-- Extensionality lemma for `accSU3`. -/ lemma accSU3_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) : accSU3 S = accSU3 T := by - simp only [accSU3, toSMSpecies_apply, Fin.isValue, LinearMap.coe_mk, AddHom.coe_mk] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - simp_all + simp only [accSU3, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, + hj] /-- The ACC for `Y²`. -/ def accYY : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, ((Q S) i + 8 * (U S) i + 2 * (D S) i + 3 * (L S) i + 6 * (E S) i) + 3 * (Hd S + Hu S) map_add' S T := by - repeat rw [map_add] - simp only [ACCSystemCharges.chargesAddCommMonoid_add, toSMSpecies_apply, reduceMul, Fin.isValue, - mul_add, Hd_apply, Fin.reduceFinMk, Hu_apply] - repeat rw [Finset.sum_add_distrib] + simp only [map_add, ACCSystemCharges.chargesAddCommMonoid_add, + sum_MSSMSpecies_numberCharges_eq_expand] ring map_smul' a S := by - repeat rw [(toSMSpecies _).map_smul] - rw [Hd.map_smul, Hu.map_smul] - simp only [HSMul.hSMul, SMul.smul, Fin.isValue, toSMSpecies_apply, reduceMul, Hd_apply, - Fin.reduceFinMk, Hu_apply, eq_ratCast, Rat.cast_eq_id, id_eq] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - -- rw [show Rat.cast a = a from rfl] + simp only [map_smul, smul_eq_mul, RingHom.id_apply] + simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring /-- Extensionality lemma for `accGrav`. -/ @@ -248,10 +203,8 @@ lemma accYY_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) (hd : Hd S = Hd T) (hu : Hu S = Hu T) : accYY S = accYY T := by - simp only [accYY, toSMSpecies_apply, Fin.isValue, LinearMap.coe_mk, AddHom.coe_mk] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - simp_all + simp only [accYY, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, + hj, hd, hu] /-- The symmetric bilinear function used to define the quadratic ACC. -/ @[simps!] @@ -309,14 +262,9 @@ lemma accQuad_ext {S T : (MSSMCharges).Charges} ∑ i, ((fun a => a^2) ∘ toSMSpecies j T) i) (hd : Hd S = Hd T) (hu : Hu S = Hu T) : accQuad S = accQuad T := by - simp only [HomogeneousQuadratic, accQuad, BiLinearSymm.toHomogeneousQuad_apply] - simp only [quadBiLin, BiLinearSymm.mk₂_toFun_apply] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - ring_nf - have h1 : ∀ j, ∑ i, (toSMSpecies j S i)^2 = ∑ i, (toSMSpecies j T i)^2 := fun j => h j - repeat rw [h1] - rw [hd, hu] + have h1 : ∀ j, ∑ i, (toSMSpecies j S i)^2 = ∑ i, (toSMSpecies j T i)^2 := h + simp only [HomogeneousQuadratic, accQuad, BiLinearSymm.toHomogeneousQuad_apply, quadBiLin, + BiLinearSymm.mk₂_toFun_apply, ← pow_two, Finset.sum_add_distrib, ← Finset.mul_sum, h1, hd, hu] /-- The function underlying the symmetric trilinear form used to define the cubic ACC. -/ def cubeTriLinToFun @@ -332,51 +280,25 @@ def cubeTriLinToFun lemma cubeTriLinToFun_map_smul₁ (a : ℚ) (S T R : MSSMCharges.Charges) : cubeTriLinToFun (a • S, T, R) = a * cubeTriLinToFun (S, T, R) := by - simp only [cubeTriLinToFun] - rw [mul_add] - congr 1 - · rw [Finset.mul_sum] - apply Fintype.sum_congr - intro i - repeat rw [map_smul] - simp only [HSMul.hSMul, SMul.smul, toSMSpecies_apply, Fin.isValue] - ring - · simp only [map_smul, Hd_apply, Fin.reduceFinMk, Fin.isValue, smul_eq_mul, Hu_apply] - ring + simp only [cubeTriLinToFun, map_smul, smul_eq_mul] + simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] + ring lemma cubeTriLinToFun_map_add₁ (S T R L : MSSMCharges.Charges) : cubeTriLinToFun (S + T, R, L) = cubeTriLinToFun (S, R, L) + cubeTriLinToFun (T, R, L) := by - simp only [cubeTriLinToFun] - rw [add_assoc, ← add_assoc (2 * Hd S * Hd R * Hd L + 2 * Hu S * Hu R * Hu L) _ _] - rw [add_comm (2 * Hd S * Hd R * Hd L + 2 * Hu S * Hu R * Hu L) _] - rw [add_assoc] - rw [← add_assoc _ _ (2 * Hd S * Hd R * Hd L + 2 * Hu S * Hu R * Hu L + - (2 * Hd T * Hd R * Hd L + 2 * Hu T * Hu R * Hu L))] - congr 1 - · rw [← Finset.sum_add_distrib] - apply Fintype.sum_congr - intro i - repeat rw [map_add] - simp only [ACCSystemCharges.chargesAddCommMonoid_add, toSMSpecies_apply, Fin.isValue] - ring - · rw [Hd.map_add, Hu.map_add] - ring + simp only [cubeTriLinToFun, map_add, ACCSystemCharges.chargesAddCommMonoid_add, + sum_MSSMSpecies_numberCharges_eq_expand] + ring lemma cubeTriLinToFun_swap1 (S T R : MSSMCharges.Charges) : cubeTriLinToFun (S, T, R) = cubeTriLinToFun (T, S, R) := by - simp only [cubeTriLinToFun, toSMSpecies_apply, Fin.isValue, Hd_apply, Fin.reduceFinMk, Hu_apply] - congr 1 - · simp only [sum_MSSMSpecies_numberCharges_eq_expand] - ring - · ring + simp only [cubeTriLinToFun, sum_MSSMSpecies_numberCharges_eq_expand] + ring lemma cubeTriLinToFun_swap2 (S T R : MSSMCharges.Charges) : cubeTriLinToFun (S, T, R) = cubeTriLinToFun (S, R, T) := by - simp only [cubeTriLinToFun, toSMSpecies_apply, Fin.isValue, Hd_apply, Fin.reduceFinMk, Hu_apply] - congr 1 - · simp only [sum_MSSMSpecies_numberCharges_eq_expand] - ring - · ring + simp only [cubeTriLinToFun, sum_MSSMSpecies_numberCharges_eq_expand] + ring /-- The symmetric trilinear form used to define the cubic ACC. -/ @[simps!] @@ -398,12 +320,10 @@ lemma accCube_ext {S T : MSSMCharges.Charges} ∑ i, ((fun a => a^3) ∘ toSMSpecies j T) i) (hd : Hd S = Hd T) (hu : Hu S = Hu T) : accCube S = accCube T := by + have h1 : ∀ j, ∑ i, (toSMSpecies j S i)^3 = ∑ i, (toSMSpecies j T i)^3 := h simp only [HomogeneousCubic, accCube, cubeTriLin, TriLinearSymm.toCubic_apply, - TriLinearSymm.mk₃_toFun_apply_apply, cubeTriLinToFun] - repeat rw [Finset.sum_add_distrib] - repeat rw [← Finset.mul_sum] - ring_nf - simp_all + TriLinearSymm.mk₃_toFun_apply_apply, cubeTriLinToFun, ← pow_three', Finset.sum_add_distrib, + ← Finset.mul_sum, h1, hd, hu] end MSSMACCs @@ -431,10 +351,7 @@ open MSSMCharges lemma cubicACC_apply (S : MSSMACC.Charges) : MSSMACC.cubicACC S = cubeTriLin.toCubic S := rfl -lemma quadSol (S : MSSMACC.QuadSols) : accQuad S.val = 0 := by - have hS := S.quadSol - simp only [HomogeneousQuadratic, MSSMACC_quadraticACCs] at hS - exact hS ⟨0, by simp⟩ +lemma quadSol (S : MSSMACC.QuadSols) : accQuad S.val = 0 := S.quadSol ⟨0, by simp⟩ /-- A solution from a charge satisfying the ACCs. -/ @[simp] diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean index 595568c0c..8bbce90b0 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean @@ -37,38 +37,27 @@ lemma lineY₃B₃Charges_val (a b : ℚ) : set_option backward.isDefEq.respectTransparency false in lemma lineY₃B₃Charges_quad (a b : ℚ) : accQuad (lineY₃B₃Charges a b).val = 0 := by change accQuad (a • Y₃.val + b • B₃.val) = 0 - rw [accQuad] - rw [quadBiLin.toHomogeneousQuad_add] - rw [quadBiLin.toHomogeneousQuad.map_smul] - rw [quadBiLin.toHomogeneousQuad.map_smul] - rw [quadBiLin.map_smul₁, quadBiLin.map_smul₂] - rw [← accQuad] - rw [quadSol Y₃.1, quadSol B₃.1] - simp only [mul_zero, add_zero, zero_add, mul_eq_zero, OfNat.ofNat_ne_zero, false_or] - apply Or.inr ∘ Or.inr - with_unfolding_all rfl + rw [accQuad, quadBiLin.toHomogeneousQuad_add, quadBiLin.toHomogeneousQuad.map_smul, + quadBiLin.toHomogeneousQuad.map_smul, quadBiLin.map_smul₁, quadBiLin.map_smul₂, ← accQuad, + quadSol Y₃.1, quadSol B₃.1, show quadBiLin Y₃.val B₃.val = 0 by with_unfolding_all rfl] + simp set_option backward.isDefEq.respectTransparency false in lemma lineY₃B₃Charges_cubic (a b : ℚ) : accCube (lineY₃B₃Charges a b).val = 0 := by change accCube (a • Y₃.val + b • B₃.val) = 0 - rw [accCube] - rw [cubeTriLin.toCubic_add] - rw [cubeTriLin.toCubic.map_smul] - rw [cubeTriLin.toCubic.map_smul] - rw [cubeTriLin.map_smul₁, cubeTriLin.map_smul₂, cubeTriLin.map_smul₃] - rw [cubeTriLin.map_smul₁, cubeTriLin.map_smul₂, cubeTriLin.map_smul₃] - repeat rw [← cubicACC_apply] - rw [Y₃.cubicSol, B₃.cubicSol] - rw [show cubeTriLin Y₃.val Y₃.val B₃.val = 0 by with_unfolding_all rfl] - rw [show cubeTriLin B₃.val B₃.val Y₃.val = 0 by with_unfolding_all rfl] + rw [accCube, cubeTriLin.toCubic_add, cubeTriLin.toCubic.map_smul, cubeTriLin.toCubic.map_smul, + cubeTriLin.map_smul₁, cubeTriLin.map_smul₂, cubeTriLin.map_smul₃, cubeTriLin.map_smul₁, + cubeTriLin.map_smul₂, cubeTriLin.map_smul₃, ← cubicACC_apply, ← cubicACC_apply, Y₃.cubicSol, + B₃.cubicSol, show cubeTriLin Y₃.val Y₃.val B₃.val = 0 by with_unfolding_all rfl, + show cubeTriLin B₃.val B₃.val Y₃.val = 0 by with_unfolding_all rfl] simp /-- The line through $Y_3$ and $B_3$ as `Sols`. -/ def lineY₃B₃ (a b : ℚ) : MSSMACC.Sols := AnomalyFreeMk' (lineY₃B₃Charges a b) (lineY₃B₃Charges_quad a b) (lineY₃B₃Charges_cubic a b) -lemma lineY₃B₃_val (a b : ℚ) : (lineY₃B₃ a b).val = a • Y₃.val + b • B₃.val := by - simp [lineY₃B₃, lineY₃B₃Charges_val] +lemma lineY₃B₃_val (a b : ℚ) : (lineY₃B₃ a b).val = a • Y₃.val + b • B₃.val := + lineY₃B₃Charges_val a b set_option backward.isDefEq.respectTransparency false in lemma doublePoint_Y₃_B₃ (R : MSSMACC.LinSols) : @@ -81,9 +70,9 @@ lemma doublePoint_Y₃_B₃ (R : MSSMACC.LinSols) : add_zero, neg_zero, Hd_apply, Fin.reduceFinMk, Hu_apply] have hLin := R.linearSol simp only [MSSMACC_linearACCs] at hLin - have h1 := hLin ⟨1, by decide⟩ - have h2 := hLin ⟨2, by decide⟩ - have h3 := hLin ⟨3, by decide⟩ + have h1 := hLin (1 : Fin 4) + have h2 := hLin (2 : Fin 4) + have h3 := hLin (3 : Fin 4) simp only [accSU2, LinearMap.coe_mk, AddHom.coe_mk, accSU3, accYY] at h1 h2 h3 erw [Fin.sum_univ_three] at h1 h2 h3 simp only [Fin.isValue, toSMSpecies_apply, Nat.reduceMul, Hd_apply, Fin.reduceFinMk, @@ -96,8 +85,7 @@ lemma lineY₃B₃_doublePoint (R : MSSMACC.LinSols) (a b : ℚ) : change cubeTriLin (a • Y₃.val + b • B₃.val) (a • Y₃.val + b • B₃.val) R.val = 0 rw [cubeTriLin.map_add₂, cubeTriLin.map_add₁, cubeTriLin.map_add₁] repeat rw [cubeTriLin.map_smul₂, cubeTriLin.map_smul₁] - rw [doublePoint_B₃_B₃, doublePoint_Y₃_Y₃, doublePoint_Y₃_B₃] - rw [cubeTriLin.swap₁, doublePoint_Y₃_B₃] - simp + simp only [cubeTriLin.swap₁ B₃.val Y₃.val R.val, doublePoint_B₃_B₃, doublePoint_Y₃_Y₃, + doublePoint_Y₃_B₃, mul_zero, add_zero] end MSSMACC diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean index d90d6d3c3..9e648b0e3 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean @@ -132,7 +132,7 @@ lemma accQuad_invariant (f : PermGroup) (S : MSSMCharges.Charges) : lemma accCube_invariant (f : PermGroup) (S : MSSMCharges.Charges) : accCube (repCharges f S) = accCube S := accCube_ext - (fun j => toSpecies_sum_invariant 3 f S j) + (toSpecies_sum_invariant 3 f S) (Hd_invariant f S) (Hu_invariant f S) diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean index d4006a91a..abdafa4b3 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean @@ -111,9 +111,8 @@ We define the decidability of `AllowsTerm` through `ofPotentialTerm'` rather tha lemma allowsTerm_iff_zero_mem_ofPotentialTerm' [DecidableEq 𝓩] {x : ChargeSpectrum 𝓩} {T : PotentialTerm} : - x.AllowsTerm T ↔ 0 ∈ x.ofPotentialTerm' T := by - rw [AllowsTerm] - exact mem_ofPotentialTerm_iff_mem_ofPotentialTerm + x.AllowsTerm T ↔ 0 ∈ x.ofPotentialTerm' T := + mem_ofPotentialTerm_iff_mem_ofPotentialTerm instance [DecidableEq 𝓩] (x : ChargeSpectrum 𝓩) (T : PotentialTerm) : Decidable (x.AllowsTerm T) := decidable_of_iff (0 ∈ x.ofPotentialTerm' T) allowsTerm_iff_zero_mem_ofPotentialTerm'.symm @@ -178,17 +177,12 @@ lemma allowsTermForm_allowsTerm {a b c : 𝓩} {T : PotentialTerm} : all_goals simp [PotentialTerm.toFieldLabel, ofFieldLabel] case Λ => exact ⟨a, b, by simp⟩ - case K1 => exact ⟨b, - a - b, by simp⟩ - case topYukawa => exact ⟨b, - a - b, by simp⟩ + case K1 | topYukawa => exact ⟨b, - a - b, by simp⟩ case W3 => refine ⟨b, -b - 2 • a, ?_⟩ simp only [true_or, or_true, and_self, true_and] abel - case W1 => - refine ⟨a, b, c, ?_⟩ - simp only [true_or, or_true, and_self, true_and] - abel - case W2 => + case W1 | W2 => refine ⟨a, b, c, ?_⟩ simp only [true_or, or_true, and_self, true_and] abel @@ -222,25 +216,17 @@ lemma allowsTermForm_eq_of_subset {a b c a' b' c' : 𝓩} {T : PotentialTerm} all_goals rw [subset_def] at h simp [allowsTermForm] at h ⊢ - case' μ => - subst h - rfl - case' β => + case' μ | β => subst h rfl - case' K2 => + case' K2 | bottomYukawa => obtain ⟨rfl, rfl, h2⟩ := h simp case' W4 => obtain ⟨h2, rfl, rfl⟩ := h simp - case' bottomYukawa => - obtain ⟨rfl, rfl, h2⟩ := h - simp case' Λ => obtain ⟨h2, h1⟩ := h - case' K1 => obtain ⟨rfl, h2⟩ := h - case' topYukawa => obtain ⟨rfl, h2⟩ := h - case' W3 => obtain ⟨rfl, h2⟩ := h + case' K1 | topYukawa | W3 => obtain ⟨rfl, h2⟩ := h case' topYukawa | W3 | K1 | Λ => rw [Finset.insert_subset_iff] at h2 simp at h2 @@ -267,10 +253,7 @@ lemma allowsTermForm_card_le_degree {a b c : 𝓩} {T : PotentialTerm} : case' W3 => have h1 : Finset.card {b, -b - 2 • a} ≤ 2 := Finset.card_le_two omega - case' K1 => - have h1 : Finset.card {b, -a - b} ≤ 2 := Finset.card_le_two - omega - case' topYukawa => + case' K1 | topYukawa => have h1 : Finset.card {b, -a - b} ≤ 2 := Finset.card_le_two omega all_goals @@ -323,39 +306,33 @@ lemma allowsTermForm_subset_allowsTerm_of_allowsTerm {T : PotentialTerm} {x : Ch simp [AllowsTerm, ofPotentialTerm, PotentialTerm.toFieldLabel, ofFieldLabel] -- Replacements of equalities case' W1 | W2 => - have hf2 : f2 = -f4 - f6 - f8 := by + obtain rfl : f2 = -f4 - f6 - f8 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel - subst hf2 simp_all case β => - have hf2 : f4 = - f2 := eq_neg_of_add_eq_zero_left f1_add_f2_eq_zero - subst hf2 + obtain rfl : f4 = - f2 := eq_neg_of_add_eq_zero_left f1_add_f2_eq_zero simp_all case K2 => - have hf2 : f2 = - f4 - f6 := by + obtain rfl : f2 = - f4 - f6 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel - subst hf2 simp_all case' Λ => - have hf2 : f2 = -f4 - f6 := by + obtain rfl : f2 = -f4 - f6 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel - subst hf2 simp_all case' W3 => subst f4_mem - have hf8 : f8 = - f6 - 2 • f4 := by + obtain rfl : f8 = - f6 - 2 • f4 := by rw [← sub_zero f8, ← f1_add_f2_eq_zero] abel - subst hf8 simp_all case' bottomYukawa => - have hf6 : f6 = - f2 - f4 := by + obtain rfl : f6 = - f2 - f4 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel - subst hf6 simp_all -- AllowsTerm case W3 => @@ -366,18 +343,16 @@ lemma allowsTermForm_subset_allowsTerm_of_allowsTerm {T : PotentialTerm} {x : Ch simp only [true_or, or_true, and_self, true_and] abel case K1 => - have hf6 : f6 = - f2 - f4 := by + obtain rfl : f6 = - f2 - f4 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel - subst hf6 simp_all use (-f2 - f4), f4 simp case' topYukawa => - have hf2 : f2 = - f4 - f6 := by + obtain rfl : f2 = - f4 - f6 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel - subst hf2 simp_all case topYukawa | Λ => use f6, f4 @@ -405,13 +380,9 @@ Given what has already been shown, this result is now trivial. -/ lemma allowsTerm_iff_subset_allowsTermForm {T : PotentialTerm} {x : ChargeSpectrum 𝓩} : x.AllowsTerm T ↔ ∃ a b c, allowsTermForm a b c T ⊆ x := by - constructor - · intro h - obtain ⟨a, b, c, h1, h2⟩ := allowsTermForm_subset_allowsTerm_of_allowsTerm h - use a, b, c - · intro h - obtain ⟨a, b, c, h1⟩ := h - apply allowsTerm_mono h1 allowsTermForm_allowsTerm + refine ⟨fun h => ?_, fun ⟨a, b, c, h1⟩ => allowsTerm_mono h1 allowsTermForm_allowsTerm⟩ + obtain ⟨a, b, c, h1, -⟩ := allowsTermForm_subset_allowsTerm_of_allowsTerm h + exact ⟨a, b, c, h1⟩ /-! @@ -429,9 +400,7 @@ less than or equal to the degree of `T`. lemma subset_card_le_degree_allowsTerm_of_allowsTerm {T : PotentialTerm} {x : ChargeSpectrum 𝓩} (h : x.AllowsTerm T) : ∃ y ∈ x.powerset, y.card ≤ T.degree ∧ y.AllowsTerm T := by obtain ⟨a, b, c, h1, h2⟩ := allowsTermForm_subset_allowsTerm_of_allowsTerm h - use allowsTermForm a b c T - simp_all - exact allowsTermForm_card_le_degree + exact ⟨_, mem_powerset_iff_subset.mpr h1, allowsTermForm_card_le_degree, h2⟩ /-! @@ -718,13 +687,10 @@ lemma allowsTerm_insertQ5_iff_allowsTermQ5 {qHd qHu : Option 𝓩} AllowsTerm ⟨qHd, qHu, insert q5 Q5, Q10⟩ T ↔ AllowsTermQ5 ⟨qHd, qHu, Q5, Q10⟩ q5 T ∨ AllowsTerm ⟨qHd, qHu, Q5, Q10⟩ T := by - constructor - · exact allowsTermQ5_or_allowsTerm_of_allowsTerm_insertQ5 T - · intro h - rcases h with h | h - · exact allowsTerm_insertQ5_of_allowsTermQ5 T h - · apply allowsTerm_mono _ h - simp [subset_def] + refine ⟨allowsTermQ5_or_allowsTerm_of_allowsTerm_insertQ5 T, ?_⟩ + rintro (h | h) + · exact allowsTerm_insertQ5_of_allowsTermQ5 T h + · exact allowsTerm_mono (by simp [subset_def]) h /-! @@ -1045,13 +1011,10 @@ lemma allowsTerm_insertQ10_iff_allowsTermQ10 {qHd qHu : Option 𝓩} AllowsTerm ⟨qHd, qHu, Q5, insert q10 Q10⟩ T ↔ AllowsTermQ10 ⟨qHd, qHu, Q5, Q10⟩ q10 T ∨ AllowsTerm ⟨qHd, qHu, Q5, Q10⟩ T := by - constructor - · exact allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 T - · intro h - rcases h with h | h - · exact allowsTerm_insertQ10_of_allowsTermQ10 T h - · apply allowsTerm_mono _ h - simp [subset_def] + refine ⟨allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 T, ?_⟩ + rintro (h | h) + · exact allowsTerm_insertQ10_of_allowsTermQ10 T h + · exact allowsTerm_mono (by simp [subset_def]) h end ChargeSpectrum diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean index 9a42d6399..ddb4dd7cd 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean @@ -98,9 +98,7 @@ def toMultisetsOne (s : Finset 𝓩) : Multiset (Multiset 𝓩) := @[simp] lemma mem_toMultisetsOne_iff [DecidableEq 𝓩] {s : Finset 𝓩} (X : Multiset 𝓩) : X ∈ toMultisetsOne s ↔ X.toFinset ⊆ s ∧ X.card = 1 := by - simp [toMultisetsOne, Multiset.card_eq_one] - rintro x rfl - simp + simp +contextual [toMultisetsOne, Multiset.card_eq_one] /-! @@ -127,8 +125,7 @@ lemma mem_toMultisetsTwo_iff [DecidableEq 𝓩] {s : Finset 𝓩} (X : Multiset · exact ⟨fun a ha => Multiset.mem_of_le h1 (Multiset.mem_toFinset.mp ha), hcard⟩ · intro ⟨hsub, hcard⟩ simp_all - rw [Multiset.card_eq_two] at hcard - obtain ⟨a, b, rfl⟩ := hcard + obtain ⟨a, b, rfl⟩ := Multiset.card_eq_two.mp hcard by_cases hab : a = b · subst hab left @@ -158,8 +155,7 @@ lemma mem_toMultisetsThree_iff [DecidableEq 𝓩] {s : Finset 𝓩} (X : Multise simp [toMultisetsThree] constructor · intro h - rw [or_assoc] at h - rcases h with ⟨a, ⟨hasub, hacard⟩, hbind⟩ | ⟨a, ha, ⟨b, hb, rfl⟩⟩ | ⟨h1, hcard⟩ + rcases h with (⟨a, ⟨hasub, hacard⟩, hbind⟩ | ⟨a, ha, ⟨b, hb, rfl⟩⟩) | ⟨h1, hcard⟩ · obtain ⟨a, rfl⟩ := Finset.card_eq_one.mp hacard subst hbind simpa using hasub @@ -168,8 +164,7 @@ lemma mem_toMultisetsThree_iff [DecidableEq 𝓩] {s : Finset 𝓩} (X : Multise · exact ⟨fun a ha => Multiset.mem_of_le h1 (Multiset.mem_toFinset.mp ha), hcard⟩ · intro ⟨hsub, hcard⟩ simp_all - rw [Multiset.card_eq_three] at hcard - obtain ⟨a, b, c, rfl⟩ := hcard + obtain ⟨a, b, c, rfl⟩ := Multiset.card_eq_three.mp hcard by_cases hab : a = b · subst hab left @@ -342,10 +337,8 @@ lemma mem_ofFinset_of_mem_minimallyAllowsTermOfFinset {S5 S10 : Finset 𝓩} {T simp_all lemma minimallyAllowsTermOfFinset_subset_ofFinset {S5 S10 : Finset 𝓩} {T : PotentialTerm} : - minimallyAllowsTermsOfFinset S5 S10 T ⊆ (ofFinset S5 S10).val := by - refine Multiset.subset_iff.mpr (fun x hx => ?_) - rw [Finset.mem_val] - exact mem_ofFinset_of_mem_minimallyAllowsTermOfFinset hx + minimallyAllowsTermsOfFinset S5 S10 T ⊆ (ofFinset S5 S10).val := + fun _ hx => Finset.mem_val.mpr (mem_ofFinset_of_mem_minimallyAllowsTermOfFinset hx) /-! @@ -386,10 +379,7 @@ lemma eq_allowsTermForm_of_mem_minimallyAllowsTermOfFinset {S5 S10 : Finset 𝓩 obtain ⟨c, rfl⟩ := Multiset.card_eq_one.mp hacard obtain ⟨d, e, rfl⟩ := Multiset.card_eq_two.mp hbcard simp_all [allowsTermForm] - use -c - simp only [neg_neg, true_and] at ⊢ hsum - use d - grind + refine ⟨-c, ?_, d, ?_⟩ <;> grind case Λ => obtain ⟨a, b, ⟨⟨⟨ha, hacard⟩, ⟨hb, hbcard⟩⟩, hsum⟩, rfl⟩ := hx obtain ⟨c, d, rfl⟩ := Multiset.card_eq_two.mp hacard @@ -411,18 +401,12 @@ lemma eq_allowsTermForm_of_mem_minimallyAllowsTermOfFinset {S5 S10 : Finset 𝓩 obtain ⟨a, b, ⟨⟨ha, ⟨hb, hbcard⟩⟩, hsum⟩, rfl⟩ := hx obtain ⟨c, d, rfl⟩ := Multiset.card_eq_two.mp hbcard simp_all [allowsTermForm] - use -a - simp_all - use c - congr - rw [← sub_eq_zero, ← hsum] - abel + refine ⟨-a, ?_, c, ?_⟩ <;> grind case W4 => obtain ⟨a, b, c, ⟨⟨ha, ⟨hb, hc, hcard⟩⟩, hsum⟩, rfl⟩ := hx obtain ⟨d, rfl⟩ := Multiset.card_eq_one.mp hcard simp_all [allowsTermForm] - use -b - grind + exact ⟨-b, by grind⟩ case K2 => obtain ⟨a, b, c, ⟨⟨ha, ⟨hb, hc, hcard⟩⟩, hsum⟩, rfl⟩ := hx obtain ⟨d, rfl⟩ := Multiset.card_eq_one.mp hcard @@ -432,10 +416,7 @@ lemma eq_allowsTermForm_of_mem_minimallyAllowsTermOfFinset {S5 S10 : Finset 𝓩 obtain ⟨a, b, ⟨⟨ha, ⟨hb, hbcard⟩⟩, hsum⟩, rfl⟩ := hx obtain ⟨c, d, rfl⟩ := Multiset.card_eq_two.mp hbcard simp_all [allowsTermForm] - use -a - simp_all - use c - grind + refine ⟨-a, ?_, c, ?_⟩ <;> grind case bottomYukawa => obtain ⟨a, b, c, ⟨⟨ha, ⟨⟨hb, hbcard⟩, hc, hcard⟩⟩, hsum⟩, rfl⟩ := hx obtain ⟨e, rfl⟩ := Multiset.card_eq_one.mp hcard @@ -498,19 +479,15 @@ lemma mem_minimallyAllowsTermOfFinset_of_minimallyAllowsTerm {S5 S10 : Finset case μ => simp_all [allowsTermForm] case β => - use {a} - simp_all [allowsTermForm] + exact ⟨{a}, by simp_all [allowsTermForm]⟩ case Λ => - use {a, b}, {- a - b} - simp_all [allowsTermForm] + exact ⟨{a, b}, {- a - b}, by simp_all [allowsTermForm]⟩ case W1 => - refine ⟨?_, h⟩ - use {- a - b - c}, {a, b, c} + refine ⟨⟨{- a - b - c}, {a, b, c}, ?_⟩, h⟩ simp_all [allowsTermForm] abel case W2 => - refine ⟨?_, h⟩ - use {a, b, c} + refine ⟨⟨{a, b, c}, ?_⟩, h⟩ simp_all [allowsTermForm] abel case W3 => @@ -518,20 +495,15 @@ lemma mem_minimallyAllowsTermOfFinset_of_minimallyAllowsTerm {S5 S10 : Finset simp_all [allowsTermForm] abel case W4 => - use {c} - simp_all [allowsTermForm] + exact ⟨{c}, by simp_all [allowsTermForm]⟩ case K1 => - use {-a}, {b, - a - b} - simp_all [allowsTermForm] + exact ⟨{-a}, {b, - a - b}, by simp_all [allowsTermForm]⟩ case K2 => - use {- a - b} - simp_all [allowsTermForm] + exact ⟨{- a - b}, by simp_all [allowsTermForm]⟩ case topYukawa => - use {b, - a - b} - simp_all [allowsTermForm] + exact ⟨{b, - a - b}, by simp_all [allowsTermForm]⟩ case bottomYukawa => - use {b}, {- a - b} - simp_all [allowsTermForm] + exact ⟨{b}, {- a - b}, by simp_all [allowsTermForm]⟩ /-! diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean index 75875eaa2..178882a41 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean @@ -84,9 +84,7 @@ This follows directly from the definition. @[simp] lemma ofFieldLabel_empty (F : FieldLabel) : ofFieldLabel (∅ : ChargeSpectrum 𝓩) F = ∅ := by - cases F - all_goals - rfl + cases F <;> rfl /-! @@ -101,10 +99,7 @@ then `ofFieldLabel x F ⊆ ofFieldLabel y F`. /-- The function `ofFieldLabel` is monotone in the charge spectrum. -/ lemma ofFieldLabel_mono {x y : ChargeSpectrum 𝓩} (h : x ⊆ y) (F : FieldLabel) : x.ofFieldLabel F ⊆ y.ofFieldLabel F := by - rw [subset_def] at h - obtain ⟨h1, h2, h3, h4⟩ := h - cases F - all_goals simp_all [ofFieldLabel] + cases F <;> simp_all [ofFieldLabel, subset_def] /-! @@ -118,20 +113,17 @@ its negative is a member of the finite set associated with the conjugate field l @[simp] lemma mem_ofFieldLabel_fiveHd (x : 𝓩) (y : ChargeSpectrum 𝓩) : x ∈ y.ofFieldLabel FieldLabel.fiveHd ↔ -x ∈ y.ofFieldLabel .fiveBarHd := by - simp [ofFieldLabel] - aesop + simp [ofFieldLabel, Finset.mem_map, neg_eq_iff_eq_neg] @[simp] lemma mem_ofFieldLabel_fiveHu (x : 𝓩) (y : ChargeSpectrum 𝓩) : x ∈ y.ofFieldLabel FieldLabel.fiveHu ↔ -x ∈ y.ofFieldLabel .fiveBarHu := by - simp [ofFieldLabel] - aesop + simp [ofFieldLabel, Finset.mem_map, neg_eq_iff_eq_neg] @[simp] lemma mem_ofFieldLabel_fiveMatter (x : 𝓩) (y : ChargeSpectrum 𝓩) : x ∈ y.ofFieldLabel FieldLabel.fiveMatter ↔ -x ∈ y.ofFieldLabel .fiveBarMatter := by - simp [ofFieldLabel] - aesop + simp [ofFieldLabel, Finset.mem_map, neg_eq_iff_eq_neg] /-! @@ -147,16 +139,8 @@ direct ways to show that two charge spectra are equal. /-- Two charges are equal if they are equal on all field labels. -/ lemma ext_ofFieldLabel {x y : ChargeSpectrum 𝓩} (h : ∀ F, x.ofFieldLabel F = y.ofFieldLabel F) : x = y := by - match x, y with - | ⟨x1, x2, x3, x4⟩, ⟨y1, y2, y3, y4⟩ => - have h1 := h FieldLabel.fiveBarHd - have h2 := h FieldLabel.fiveBarHu - have h3 := h FieldLabel.fiveBarMatter - have h4 := h FieldLabel.tenMatter - clear h - simp_all [ofFieldLabel] - rw [← Option.toFinset_inj] at h1 h2 - simp_all + exact eq_of_parts (Option.toFinset_inj.mpr (h .fiveBarHd)) + (Option.toFinset_inj.mpr (h .fiveBarHu)) (h .fiveBarMatter) (h .tenMatter) end ChargeSpectrum diff --git a/Physlib/Particles/SuperSymmetry/SU5/Potential.lean b/Physlib/Particles/SuperSymmetry/SU5/Potential.lean index e0a55f943..1954ab245 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/Potential.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/Potential.lean @@ -182,8 +182,8 @@ The degree of all terms present is less than or equal to four. def degree (T : PotentialTerm) : ℕ := T.toFieldLabel.length lemma degree_le_four (T : PotentialTerm) : T.degree ≤ 4 := by - cases T - all_goals simp [toFieldLabel, degree] + revert T + decide /-! diff --git a/Physlib/QFT/AnomalyCancellation/Basic.lean b/Physlib/QFT/AnomalyCancellation/Basic.lean index d9b158e81..496fc4651 100644 --- a/Physlib/QFT/AnomalyCancellation/Basic.lean +++ b/Physlib/QFT/AnomalyCancellation/Basic.lean @@ -346,10 +346,8 @@ def quadSolsInclLinSols (χ : ACCSystemQuad) : χ.QuadSols →[ℚ] χ.LinSols w map_smul' _ _ := rfl lemma quadSolsInclLinSols_injective (χ : ACCSystemQuad) : - Function.Injective χ.quadSolsInclLinSols := by - intro S T h - ext - exact congrArg (fun X => X.val) h + Function.Injective χ.quadSolsInclLinSols := + fun _ _ h => QuadSols.ext (congrArg (fun X => X.val) h) /-! @@ -381,12 +379,9 @@ def quadSolsIncl (χ : ACCSystemQuad) : χ.QuadSols →[ℚ] χ.Charges := MulActionHom.comp χ.linSolsIncl.toMulActionHom χ.quadSolsInclLinSols lemma quadSolsIncl_injective (χ : ACCSystemQuad) : - Function.Injective χ.quadSolsIncl := by - intro S T h - have h' : χ.quadSolsInclLinSols S = χ.quadSolsInclLinSols T := by - apply ACCSystemLinear.linSolsIncl_injective (χ := χ.toACCSystemLinear) - exact h - exact quadSolsInclLinSols_injective χ h' + Function.Injective χ.quadSolsIncl := + fun _ _ h => quadSolsInclLinSols_injective χ + (ACCSystemLinear.linSolsIncl_injective χ.toACCSystemLinear h) end ACCSystemQuad @@ -485,12 +480,8 @@ def solsInclQuadSols (χ : ACCSystem) : χ.Sols →[ℚ] χ.QuadSols where map_smul' _ _ := rfl lemma solsInclQuadSols_injective (χ : ACCSystem) : - Function.Injective χ.solsInclQuadSols := by - intro S T h - apply Sols.ext - have hv : (χ.solsInclQuadSols S).val = (χ.solsInclQuadSols T).val := - congrArg (fun X => X.val) h - exact hv + Function.Injective χ.solsInclQuadSols := + fun _ _ h => Sols.ext (congrArg (fun X => X.val) h) /-! @@ -502,12 +493,9 @@ def solsInclLinSols (χ : ACCSystem) : χ.Sols →[ℚ] χ.LinSols := MulActionHom.comp χ.quadSolsInclLinSols χ.solsInclQuadSols lemma solsInclLinSols_injective (χ : ACCSystem) : - Function.Injective χ.solsInclLinSols := by - intro S T h - have h' : χ.solsInclQuadSols S = χ.solsInclQuadSols T := by - apply ACCSystemQuad.quadSolsInclLinSols_injective (χ := χ.toACCSystemQuad) - simpa [ACCSystem.solsInclLinSols, MulActionHom.comp_apply] using h - exact solsInclQuadSols_injective χ h' + Function.Injective χ.solsInclLinSols := + fun _ _ h => solsInclQuadSols_injective χ + (ACCSystemQuad.quadSolsInclLinSols_injective χ.toACCSystemQuad h) /-! @@ -520,12 +508,9 @@ def solsIncl (χ : ACCSystem) : χ.Sols →[ℚ] χ.Charges := MulActionHom.comp χ.quadSolsIncl χ.solsInclQuadSols lemma solsIncl_injective (χ : ACCSystem) : - Function.Injective χ.solsIncl := by - intro S T h - have h' : χ.solsInclQuadSols S = χ.solsInclQuadSols T := by - apply ACCSystemQuad.quadSolsIncl_injective (χ := χ.toACCSystemQuad) - simpa [ACCSystem.solsIncl, MulActionHom.comp_apply] using h - exact (solsInclQuadSols_injective χ) h' + Function.Injective χ.solsIncl := + fun _ _ h => solsInclQuadSols_injective χ + (ACCSystemQuad.quadSolsIncl_injective χ.toACCSystemQuad h) /-! diff --git a/Physlib/QFT/PerturbationTheory/CreateAnnihilate.lean b/Physlib/QFT/PerturbationTheory/CreateAnnihilate.lean index a7cf23bbb..709182f8a 100644 --- a/Physlib/QFT/PerturbationTheory/CreateAnnihilate.lean +++ b/Physlib/QFT/PerturbationTheory/CreateAnnihilate.lean @@ -53,13 +53,11 @@ instance : (φ φ' : CreateAnnihilate) → Decidable (normalOrder φ φ') /-- Normal ordering is total. -/ instance : Std.Total normalOrder where - total a b := by - cases a <;> cases b <;> simp [normalOrder] + total := by decide /-- Normal ordering is transitive. -/ instance : IsTrans CreateAnnihilate normalOrder where - trans a b c := by - cases a <;> cases b <;> cases c <;> simp [normalOrder] + trans := by decide @[simp] lemma not_normalOrder_annihilate_iff_false (a : CreateAnnihilate) : diff --git a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean index 3cb794dd1..488e93a94 100644 --- a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean +++ b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean @@ -115,17 +115,11 @@ lemma normalOrderF_normalOrderF_mid (a b c : 𝓕.FieldOpFreeAlgebra) : lemma normalOrderF_normalOrderF_right (a b : 𝓕.FieldOpFreeAlgebra) : 𝓝ᶠ(a * b) = 𝓝ᶠ(a * 𝓝ᶠ(b)) := by - trans 𝓝ᶠ(a * b * 1) - · simp - · rw [normalOrderF_normalOrderF_mid] - simp + simpa using normalOrderF_normalOrderF_mid a b 1 lemma normalOrderF_normalOrderF_left (a b : 𝓕.FieldOpFreeAlgebra) : 𝓝ᶠ(a * b) = 𝓝ᶠ(𝓝ᶠ(a) * b) := by - trans 𝓝ᶠ(1 * a * b) - · simp - · rw [normalOrderF_normalOrderF_mid] - simp + simpa using normalOrderF_normalOrderF_mid 1 a b /-! @@ -137,8 +131,8 @@ lemma normalOrderF_ofCrAnListF_cons_create (φ : 𝓕.CrAnFieldOp) (hφ : 𝓕 |>ᶜ φ = CreateAnnihilate.create) (φs : List 𝓕.CrAnFieldOp) : 𝓝ᶠ(ofCrAnListF (φ :: φs)) = ofCrAnOpF φ * 𝓝ᶠ(ofCrAnListF φs) := by rw [normalOrderF_ofCrAnListF, normalOrderSign_cons_create φ hφ, - normalOrderList_cons_create φ hφ φs] - rw [ofCrAnListF_cons, normalOrderF_ofCrAnListF, mul_smul_comm] + normalOrderList_cons_create φ hφ φs, ofCrAnListF_cons, normalOrderF_ofCrAnListF, + mul_smul_comm] lemma normalOrderF_create_mul (φ : 𝓕.CrAnFieldOp) (hφ : 𝓕 |>ᶜ φ = CreateAnnihilate.create) (a : FieldOpFreeAlgebra 𝓕) : @@ -172,25 +166,15 @@ lemma normalOrderF_crPartF_mul (φ : 𝓕.FieldOp) (a : FieldOpFreeAlgebra 𝓕) 𝓝ᶠ(crPartF φ * a) = crPartF φ * 𝓝ᶠ(a) := by match φ with - | .inAsymp φ => - rw [crPartF] - exact normalOrderF_create_mul ⟨FieldOp.inAsymp φ, ()⟩ rfl a - | .position φ => - rw [crPartF] - exact normalOrderF_create_mul _ rfl _ - | .outAsymp φ => simp + | .inAsymp _ | .position _ => exact normalOrderF_create_mul _ rfl _ + | .outAsymp _ => simp lemma normalOrderF_mul_anPartF (φ : 𝓕.FieldOp) (a : FieldOpFreeAlgebra 𝓕) : 𝓝ᶠ(a * anPartF φ) = 𝓝ᶠ(a) * anPartF φ := by match φ with - | .inAsymp φ => simp - | .position φ => - rw [anPartF] - exact normalOrderF_mul_annihilate _ rfl _ - | .outAsymp φ => - rw [anPartF] - refine normalOrderF_mul_annihilate _ rfl _ + | .inAsymp _ => simp + | .position _ | .outAsymp _ => exact normalOrderF_mul_annihilate _ rfl _ /-! @@ -253,9 +237,7 @@ lemma normalOrderF_superCommuteF_annihilate_create (φc φa : 𝓕.CrAnFieldOp) (a b : 𝓕.FieldOpFreeAlgebra) : 𝓝ᶠ(a * [ofCrAnOpF φa, ofCrAnOpF φc]ₛF * b) = 0 := by rw [superCommuteF_ofCrAnOpF_ofCrAnOpF_symm] - simp only [neg_smul, mul_neg, Algebra.mul_smul_comm, neg_mul, - Algebra.smul_mul_assoc, map_neg, map_smul, neg_eq_zero, smul_eq_zero] - exact Or.inr (normalOrderF_superCommuteF_create_annihilate φc φa hφc hφa ..) + simp [normalOrderF_superCommuteF_create_annihilate φc φa hφc hφa] lemma normalOrderF_swap_crPartF_anPartF (φ φ' : 𝓕.FieldOp) (a b : FieldOpFreeAlgebra 𝓕) : 𝓝ᶠ(a * (crPartF φ) * (anPartF φ') * b) = @@ -264,26 +246,9 @@ lemma normalOrderF_swap_crPartF_anPartF (φ φ' : 𝓕.FieldOp) (a b : FieldOpFr match φ, φ' with | _, .inAsymp φ' => simp | .outAsymp φ, _ => simp - | .position φ, .position φ' => - simp only [crPartF_position, anPartF_position] - rw [normalOrderF_swap_create_annihilate] - simp only [crAnStatistics, Function.comp_apply, crAnFieldOpToFieldOp_prod] - rfl; rfl - | .inAsymp φ, .outAsymp φ' => - simp only [crPartF_negAsymp, anPartF_posAsymp] - rw [normalOrderF_swap_create_annihilate] - simp only [crAnStatistics, Function.comp_apply, crAnFieldOpToFieldOp_prod] - rfl; rfl - | .inAsymp φ, .position φ' => - simp only [crPartF_negAsymp, anPartF_position] - rw [normalOrderF_swap_create_annihilate] - simp only [crAnStatistics, Function.comp_apply, crAnFieldOpToFieldOp_prod] - rfl; rfl - | .position φ, .outAsymp φ' => - simp only [crPartF_position, anPartF_posAsymp] - rw [normalOrderF_swap_create_annihilate] - simp only [crAnStatistics, Function.comp_apply, crAnFieldOpToFieldOp_prod] - rfl; rfl + | .inAsymp _, .position _ | .inAsymp _, .outAsymp _ + | .position _, .position _ | .position _, .outAsymp _ => + exact normalOrderF_swap_create_annihilate _ _ rfl rfl .. /-! @@ -305,17 +270,8 @@ lemma normalOrderF_superCommuteF_crPartF_anPartF (φ φ' : 𝓕.FieldOp) (a b : match φ, φ' with | _, .inAsymp φ' => simp | .outAsymp φ', _ => simp - | .position φ, .position φ' => - rw [crPartF_position, anPartF_position] - exact normalOrderF_superCommuteF_create_annihilate _ _ rfl rfl .. - | .inAsymp φ, .outAsymp φ' => - rw [crPartF_negAsymp, anPartF_posAsymp] - exact normalOrderF_superCommuteF_create_annihilate _ _ rfl rfl .. - | .inAsymp φ, .position φ' => - rw [crPartF_negAsymp, anPartF_position] - exact normalOrderF_superCommuteF_create_annihilate _ _ rfl rfl .. - | .position φ, .outAsymp φ' => - rw [crPartF_position, anPartF_posAsymp] + | .inAsymp _, .position _ | .inAsymp _, .outAsymp _ + | .position _, .position _ | .position _, .outAsymp _ => exact normalOrderF_superCommuteF_create_annihilate _ _ rfl rfl .. lemma normalOrderF_superCommuteF_anPartF_crPartF (φ φ' : 𝓕.FieldOp) (a b : FieldOpFreeAlgebra 𝓕) : @@ -324,17 +280,8 @@ lemma normalOrderF_superCommuteF_anPartF_crPartF (φ φ' : 𝓕.FieldOp) (a b : match φ, φ' with | .inAsymp φ', _ => simp | _, .outAsymp φ' => simp - | .position φ, .position φ' => - rw [anPartF_position, crPartF_position] - exact normalOrderF_superCommuteF_annihilate_create _ _ rfl rfl .. - | .outAsymp φ', .inAsymp φ => - simp only [anPartF_posAsymp, crPartF_negAsymp] - exact normalOrderF_superCommuteF_annihilate_create _ _ rfl rfl .. - | .position φ', .inAsymp φ => - simp only [anPartF_position, crPartF_negAsymp] - exact normalOrderF_superCommuteF_annihilate_create _ _ rfl rfl .. - | .outAsymp φ, .position φ' => - simp only [anPartF_posAsymp, crPartF_position] + | .position _, .position _ | .position _, .inAsymp _ + | .outAsymp _, .position _ | .outAsymp _, .inAsymp _ => exact normalOrderF_superCommuteF_annihilate_create _ _ rfl rfl .. /-! @@ -347,39 +294,29 @@ lemma normalOrderF_superCommuteF_anPartF_crPartF (φ φ' : 𝓕.FieldOp) (a b : lemma normalOrderF_crPartF_mul_crPartF (φ φ' : 𝓕.FieldOp) : 𝓝ᶠ(crPartF φ * crPartF φ') = crPartF φ * crPartF φ' := by - rw [normalOrderF_crPartF_mul] - conv_lhs => rw [← mul_one (crPartF φ')] - rw [normalOrderF_crPartF_mul, normalOrderF_one] - simp + rw [normalOrderF_crPartF_mul, ← mul_one (crPartF φ'), normalOrderF_crPartF_mul, + normalOrderF_one] @[simp] lemma normalOrderF_anPartF_mul_anPartF (φ φ' : 𝓕.FieldOp) : 𝓝ᶠ(anPartF φ * anPartF φ') = anPartF φ * anPartF φ' := by - rw [normalOrderF_mul_anPartF] - conv_lhs => rw [← one_mul (anPartF φ)] - rw [normalOrderF_mul_anPartF, normalOrderF_one] - simp + rw [normalOrderF_mul_anPartF, ← one_mul (anPartF φ), normalOrderF_mul_anPartF, + normalOrderF_one] @[simp] lemma normalOrderF_crPartF_mul_anPartF (φ φ' : 𝓕.FieldOp) : 𝓝ᶠ(crPartF φ * anPartF φ') = crPartF φ * anPartF φ' := by - rw [normalOrderF_crPartF_mul] - conv_lhs => rw [← one_mul (anPartF φ')] - rw [normalOrderF_mul_anPartF, normalOrderF_one] - simp + rw [normalOrderF_crPartF_mul, ← one_mul (anPartF φ'), normalOrderF_mul_anPartF, + normalOrderF_one] @[simp] lemma normalOrderF_anPartF_mul_crPartF (φ φ' : 𝓕.FieldOp) : 𝓝ᶠ(anPartF φ * crPartF φ') = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • (crPartF φ' * anPartF φ) := by - conv_lhs => rw [← one_mul (anPartF φ * crPartF φ')] - conv_lhs => rw [← mul_one (1 * (anPartF φ * - crPartF φ'))] - rw [← mul_assoc, normalOrderF_swap_anPartF_crPartF] - simp + simpa using normalOrderF_swap_anPartF_crPartF φ φ' 1 1 lemma normalOrderF_ofFieldOpF_mul_ofFieldOpF (φ φ' : 𝓕.FieldOp) : 𝓝ᶠ(ofFieldOpF φ * ofFieldOpF φ') = @@ -388,9 +325,8 @@ lemma normalOrderF_ofFieldOpF_mul_ofFieldOpF (φ φ' : 𝓕.FieldOp) : (crPartF φ' * anPartF φ) + crPartF φ * anPartF φ' + anPartF φ * anPartF φ' := by - rw [ofFieldOpF_eq_crPartF_add_anPartF, ofFieldOpF_eq_crPartF_add_anPartF, mul_add, add_mul, - add_mul] - simp only [map_add, normalOrderF_crPartF_mul_crPartF, normalOrderF_anPartF_mul_crPartF, + simp only [ofFieldOpF_eq_crPartF_add_anPartF, mul_add, add_mul, map_add, + normalOrderF_crPartF_mul_crPartF, normalOrderF_anPartF_mul_crPartF, normalOrderF_crPartF_mul_anPartF, normalOrderF_anPartF_mul_anPartF] abel @@ -580,9 +516,9 @@ lemma anPartF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF (φ : 𝓕.FieldO + [anPartF φ, 𝓝ᶠ(ofFieldOpListF φs')]ₛF := by rw [normalOrderF_mul_anPartF] match φ with - | .inAsymp φ => simp - | .position φ => simp [ofCrAnOpF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF, crAnStatistics] - | .outAsymp φ => simp [ofCrAnOpF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF, crAnStatistics] + | .inAsymp _ => simp + | .position _ | .outAsymp _ => + simp [ofCrAnOpF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF, crAnStatistics] end diff --git a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean index 84da10d1b..e0eab7d29 100644 --- a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean +++ b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean @@ -52,17 +52,14 @@ scoped[FieldSpecification.FieldOpFreeAlgebra] notation "[" φs "," φs' "]ₛF" lemma superCommuteF_ofCrAnListF_ofCrAnListF (φs φs' : List 𝓕.CrAnFieldOp) : [ofCrAnListF φs, ofCrAnListF φs']ₛF = ofCrAnListF (φs ++ φs') - 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofCrAnListF (φs' ++ φs) := by - rw [← ofListBasis_eq_ofList, ← ofListBasis_eq_ofList] - simp only [superCommuteF, Basis.constr_basis] + simp only [← ofListBasis_eq_ofList, superCommuteF, Basis.constr_basis] lemma superCommuteF_ofCrAnOpF_ofCrAnOpF (φ φ' : 𝓕.CrAnFieldOp) : [ofCrAnOpF φ, ofCrAnOpF φ']ₛF = ofCrAnOpF φ * ofCrAnOpF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofCrAnOpF φ' * ofCrAnOpF φ := by - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton] - rw [superCommuteF_ofCrAnListF_ofCrAnListF, ofCrAnListF_append] - congr - rw [ofCrAnListF_append] - rw [FieldStatistic.ofList_singleton, FieldStatistic.ofList_singleton, smul_mul_assoc] + rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF, + ofCrAnListF_append, ofCrAnListF_append] + simp [FieldStatistic.ofList_singleton] lemma superCommuteF_ofCrAnListF_ofFieldOpFsList (φcas : List 𝓕.CrAnFieldOp) (φs : List 𝓕.FieldOp) : [ofCrAnListF φcas, ofFieldOpListF φs]ₛF = ofCrAnListF φcas * ofFieldOpListF φs - @@ -108,80 +105,66 @@ lemma superCommuteF_anPartF_crPartF (φ φ' : 𝓕.FieldOp) : 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPartF φ' * anPartF φ := by match φ, φ' with | FieldOp.inAsymp φ, _ => - simp - | _, FieldOp.outAsymp φ => - simp only [crPartF_posAsymp, map_zero, mul_zero, smul_zero, zero_mul, + simp only [anPartF_negAsymp, map_zero, LinearMap.zero_apply, zero_mul, mul_zero, sub_self] + | _, FieldOp.outAsymp φ => + simp only [crPartF_posAsymp, map_zero, mul_zero, smul_zero, zero_mul, sub_self] | FieldOp.position φ, FieldOp.position φ' => - simp only [anPartF_position, crPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_position, crPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.outAsymp φ, FieldOp.position φ' => - simp only [anPartF_posAsymp, crPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_posAsymp, crPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.position φ, FieldOp.inAsymp φ' => - simp only [anPartF_position, crPartF_negAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp only [List.singleton_append, crAnStatistics, - FieldStatistic.ofList_singleton, Function.comp_apply, crAnFieldOpToFieldOp_prod, ← - ofCrAnListF_append] + simp [anPartF_position, crPartF_negAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.outAsymp φ, FieldOp.inAsymp φ' => - simp only [anPartF_posAsymp, crPartF_negAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_posAsymp, crPartF_negAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] lemma superCommuteF_crPartF_anPartF (φ φ' : 𝓕.FieldOp) : [crPartF φ, anPartF φ']ₛF = crPartF φ * anPartF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPartF φ' * crPartF φ := by - match φ, φ' with - | FieldOp.outAsymp φ, _ => - simp only [crPartF_posAsymp, map_zero, LinearMap.zero_apply, zero_mul, mul_zero, sub_self] - | _, FieldOp.inAsymp φ => - simp only [anPartF_negAsymp, map_zero, mul_zero, smul_zero, zero_mul, + match φ, φ' with + | FieldOp.outAsymp φ, _ => + simp only [crPartF_posAsymp, map_zero, LinearMap.zero_apply, zero_mul, mul_zero, sub_self] - | FieldOp.position φ, FieldOp.position φ' => - simp only [crPartF_position, anPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] - | FieldOp.position φ, FieldOp.outAsymp φ' => - simp only [crPartF_position, anPartF_posAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] - | FieldOp.inAsymp φ, FieldOp.position φ' => - simp only [crPartF_negAsymp, anPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] - | FieldOp.inAsymp φ, FieldOp.outAsymp φ' => - simp only [crPartF_negAsymp, anPartF_posAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + | _, FieldOp.inAsymp φ => + simp only [anPartF_negAsymp, map_zero, mul_zero, smul_zero, zero_mul, sub_self] + | FieldOp.position φ, FieldOp.position φ' => + simp [crPartF_position, anPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] + | FieldOp.position φ, FieldOp.outAsymp φ' => + simp [crPartF_position, anPartF_posAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] + | FieldOp.inAsymp φ, FieldOp.position φ' => + simp [crPartF_negAsymp, anPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] + | FieldOp.inAsymp φ, FieldOp.outAsymp φ' => + simp [crPartF_negAsymp, anPartF_posAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] lemma superCommuteF_crPartF_crPartF (φ φ' : 𝓕.FieldOp) : [crPartF φ, crPartF φ']ₛF = crPartF φ * crPartF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPartF φ' * crPartF φ := by match φ, φ' with | FieldOp.outAsymp φ, _ => - simp only [crPartF_posAsymp, map_zero, LinearMap.zero_apply, zero_mul, mul_zero, sub_self] + simp only [crPartF_posAsymp, map_zero, LinearMap.zero_apply, zero_mul, mul_zero, + sub_self] | _, FieldOp.outAsymp φ => - simp only [crPartF_posAsymp, map_zero, mul_zero, smul_zero, zero_mul, - sub_self] + simp only [crPartF_posAsymp, map_zero, mul_zero, smul_zero, zero_mul, sub_self] | FieldOp.position φ, FieldOp.position φ' => - simp only [crPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [crPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.position φ, FieldOp.inAsymp φ' => - simp only [crPartF_position, crPartF_negAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [crPartF_position, crPartF_negAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.inAsymp φ, FieldOp.position φ' => - simp only [crPartF_negAsymp, crPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [crPartF_negAsymp, crPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.inAsymp φ, FieldOp.inAsymp φ' => - simp only [crPartF_negAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [crPartF_negAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] lemma superCommuteF_anPartF_anPartF (φ φ' : 𝓕.FieldOp) : [anPartF φ, anPartF φ']ₛF = @@ -192,21 +175,17 @@ lemma superCommuteF_anPartF_anPartF (φ φ' : 𝓕.FieldOp) : | _, FieldOp.inAsymp φ => simp | FieldOp.position φ, FieldOp.position φ' => - simp only [anPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.position φ, FieldOp.outAsymp φ' => - simp only [anPartF_position, anPartF_posAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_position, anPartF_posAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.outAsymp φ, FieldOp.position φ' => - simp only [anPartF_posAsymp, anPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_posAsymp, anPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] | FieldOp.outAsymp φ, FieldOp.outAsymp φ' => - simp only [anPartF_posAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF] - simp [crAnStatistics, ← ofCrAnListF_append] + simp [anPartF_posAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] lemma superCommuteF_crPartF_ofFieldOpListF (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : [crPartF φ, ofFieldOpListF φs]ₛF = @@ -214,13 +193,11 @@ lemma superCommuteF_crPartF_ofFieldOpListF (φ : 𝓕.FieldOp) (φs : List 𝓕. crPartF φ := by match φ with | FieldOp.inAsymp φ => - simp only [crPartF_negAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofFieldOpFsList] - simp [crAnStatistics] + simp [crPartF_negAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofFieldOpFsList, crAnStatistics] | FieldOp.position φ => - simp only [crPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofFieldOpFsList] - simp [crAnStatistics] + simp [crPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofFieldOpFsList, crAnStatistics] | FieldOp.outAsymp φ => simp @@ -232,13 +209,11 @@ lemma superCommuteF_anPartF_ofFieldOpListF (φ : 𝓕.FieldOp) (φs : List 𝓕. | FieldOp.inAsymp φ => simp | FieldOp.position φ => - simp only [anPartF_position, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofFieldOpFsList] - simp [crAnStatistics] + simp [anPartF_position, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofFieldOpFsList, crAnStatistics] | FieldOp.outAsymp φ => - simp only [anPartF_posAsymp, Algebra.smul_mul_assoc] - rw [← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofFieldOpFsList] - simp [crAnStatistics] + simp [anPartF_posAsymp, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofFieldOpFsList, crAnStatistics] lemma superCommuteF_crPartF_ofFieldOpF (φ φ' : 𝓕.FieldOp) : [crPartF φ, ofFieldOpF φ']ₛF = @@ -284,14 +259,12 @@ lemma ofFieldOpListF_mul_ofFieldOpListF_eq_superCommuteF (φs φs' : List 𝓕.F lemma ofFieldOpF_mul_ofFieldOpListF_eq_superCommuteF (φ : 𝓕.FieldOp) (φs' : List 𝓕.FieldOp) : ofFieldOpF φ * ofFieldOpListF φs' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs') • ofFieldOpListF φs' * ofFieldOpF φ + [ofFieldOpF φ, ofFieldOpListF φs']ₛF := by - rw [superCommuteF_ofFieldOpF_ofFieldOpFsList] - simp + simp [superCommuteF_ofFieldOpF_ofFieldOpFsList] lemma ofFieldOpListF_mul_ofFieldOpF_eq_superCommuteF (φs : List 𝓕.FieldOp) (φ : 𝓕.FieldOp) : ofFieldOpListF φs * ofFieldOpF φ = 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φ) • ofFieldOpF φ * ofFieldOpListF φs + [ofFieldOpListF φs, ofFieldOpF φ]ₛF := by - rw [superCommuteF_ofFieldOpListF_ofFieldOpF] - simp + simp [superCommuteF_ofFieldOpListF_ofFieldOpF] lemma crPartF_mul_anPartF_eq_superCommuteF (φ φ' : 𝓕.FieldOp) : crPartF φ * anPartF φ' = @@ -349,8 +322,7 @@ lemma superCommuteF_ofCrAnListF_ofCrAnListF_symm (φs φs' : List 𝓕.CrAnField lemma superCommuteF_ofCrAnOpF_ofCrAnOpF_symm (φ φ' : 𝓕.CrAnFieldOp) : [ofCrAnOpF φ, ofCrAnOpF φ']ₛF = (- 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ')) • [ofCrAnOpF φ', ofCrAnOpF φ]ₛF := by - rw [superCommuteF_ofCrAnOpF_ofCrAnOpF, superCommuteF_ofCrAnOpF_ofCrAnOpF] - rw [smul_sub] + rw [superCommuteF_ofCrAnOpF_ofCrAnOpF, superCommuteF_ofCrAnOpF_ofCrAnOpF, smul_sub] simp only [Algebra.smul_mul_assoc, neg_smul, sub_neg_eq_add] rw [smul_smul] conv_rhs => @@ -420,10 +392,7 @@ lemma superCommuteF_ofCrAnListF_ofCrAnListF_eq_sum (φs : List 𝓕.CrAnFieldOp) ofCrAnListF (φs'.take n) * [ofCrAnListF φs, ofCrAnOpF (φs'.get n)]ₛF * ofCrAnListF (φs'.drop (n + 1)) | [] => by - simp only [ofCrAnListF_nil, List.length_nil, Finset.univ_eq_empty, - List.take_nil, ofList_empty, exchangeSign_bosonic, one_smul, List.get_eq_getElem, one_mul, - List.drop_nil, mul_one, Finset.sum_empty] - rw [← ofCrAnListF_nil, superCommuteF_ofCrAnListF_ofCrAnListF] + rw [superCommuteF_ofCrAnListF_ofCrAnListF] simp | φ :: φs' => by rw [superCommuteF_ofCrAnListF_ofCrAnListF_cons, @@ -441,9 +410,7 @@ lemma superCommuteF_ofCrAnListF_ofFieldOpListF_eq_sum (φs : List 𝓕.CrAnField ofFieldOpListF (φs'.take n) * [ofCrAnListF φs, ofFieldOpF (φs'.get n)]ₛF * ofFieldOpListF (φs'.drop (n + 1)) | [] => by - simp only [superCommuteF_ofCrAnListF_ofFieldOpFsList, ofList_empty, - exchangeSign_bosonic, one_smul, List.length_nil, Finset.univ_eq_empty, List.take_nil, - List.get_eq_getElem, List.drop_nil, Finset.sum_empty] + rw [superCommuteF_ofCrAnListF_ofFieldOpFsList] simp | φ :: φs' => by rw [superCommuteF_ofCrAnListF_ofFieldOpListF_cons, @@ -465,37 +432,10 @@ lemma summerCommute_jacobi_ofCrAnListF (φs1 φs2 φs3 : List 𝓕.CrAnFieldOp) simp only [ofList_append_eq_mul, List.append_assoc] by_cases h1 : (𝓕 |>ₛ φs1) = bosonic <;> by_cases h2 : (𝓕 |>ₛ φs2) = bosonic <;> - by_cases h3 : (𝓕 |>ₛ φs3) = bosonic - · simp only [h1, h2, h3, mul_self, bosonic_exchangeSign, one_smul, exchangeSign_bosonic, neg_sub] - abel - · simp only [h1, h2, bosonic_exchangeSign, one_smul, mul_bosonic, mul_self, map_one, - exchangeSign_bosonic, neg_sub] - abel - · simp only [h1, h3, mul_bosonic, bosonic_exchangeSign, one_smul, exchangeSign_bosonic, neg_sub, - mul_self, map_one] - abel - · simp only [neq_bosonic_iff_eq_fermionic] at h1 h2 h3 - simp only [h1, h2, h3, mul_self, bosonic_exchangeSign, one_smul, - fermionic_exchangeSign_fermionic, neg_smul, neg_sub, bosonic_mul_fermionic, sub_neg_eq_add, - mul_bosonic, smul_add, exchangeSign_bosonic] - abel - · simp only [neq_bosonic_iff_eq_fermionic] at h1 h2 h3 - simp only [h1, h2, h3, mul_self, map_one, one_smul, exchangeSign_bosonic, mul_bosonic, - bosonic_exchangeSign, bosonic_mul_fermionic, neg_sub] - abel - · simp only [neq_bosonic_iff_eq_fermionic] at h1 h2 h3 - simp only [h1, h2, h3, bosonic_mul_fermionic, fermionic_exchangeSign_fermionic, neg_smul, - one_smul, sub_neg_eq_add, bosonic_exchangeSign, mul_bosonic, smul_add, exchangeSign_bosonic, - neg_sub, mul_self] - abel - · simp only [neq_bosonic_iff_eq_fermionic] at h1 h2 h3 - simp only [h1, h2, h3, mul_bosonic, fermionic_exchangeSign_fermionic, neg_smul, one_smul, - sub_neg_eq_add, exchangeSign_bosonic, bosonic_mul_fermionic, smul_add, mul_self, - bosonic_exchangeSign, neg_sub] - abel - · simp only [neq_bosonic_iff_eq_fermionic] at h1 h2 h3 - simp only [h1, h2, h3, mul_self, map_one, one_smul, fermionic_exchangeSign_fermionic, neg_smul, - neg_sub] + by_cases h3 : (𝓕 |>ₛ φs3) = bosonic <;> + simp_all only [neq_bosonic_iff_eq_fermionic, mul_self, bosonic_exchangeSign, one_smul, + exchangeSign_bosonic, neg_sub, mul_bosonic, map_one, fermionic_exchangeSign_fermionic, + neg_smul, bosonic_mul_fermionic, sub_neg_eq_add, smul_add] <;> abel /-! @@ -527,8 +467,7 @@ lemma superCommuteF_grade {a b : 𝓕.FieldOpFreeAlgebra} {f1 f2 : FieldStatisti rw [ofList_append_eq_mul, hφs, hφs'] · apply Submodule.smul_mem apply ofCrAnListF_mem_statisticSubmodule_of - rw [ofList_append_eq_mul, hφs, hφs'] - rw [mul_comm] + rw [ofList_append_eq_mul, hφs, hφs', mul_comm] · simp [p] · intro x y hx hy hp1 hp2 simp only [add_eq_mul, map_add, LinearMap.add_apply, p] @@ -561,9 +500,7 @@ lemma superCommuteF_bosonic_bosonic {a b : 𝓕.FieldOpFreeAlgebra} apply Submodule.span_induction (p := p) · intro x hx obtain ⟨φs', rfl, hφs'⟩ := hx - simp only [p] - rw [superCommuteF_ofCrAnListF_ofCrAnListF] - simp [hφs, ofCrAnListF_append] + simp [p, hφs, ofCrAnListF_append, superCommuteF_ofCrAnListF_ofCrAnListF] · simp [p] · intro x y hx hy hp1 hp2 simp_all only [p, map_add, LinearMap.add_apply, add_mul, mul_add] @@ -594,9 +531,7 @@ lemma superCommuteF_bosonic_fermionic {a b : 𝓕.FieldOpFreeAlgebra} apply Submodule.span_induction (p := p) · intro x hx obtain ⟨φs', rfl, hφs'⟩ := hx - simp only [p] - rw [superCommuteF_ofCrAnListF_ofCrAnListF] - simp [hφs, hφs', ofCrAnListF_append] + simp [p, hφs, hφs', ofCrAnListF_append, superCommuteF_ofCrAnListF_ofCrAnListF] · simp [p] · intro x y hx hy hp1 hp2 simp_all only [p, map_add, LinearMap.add_apply, add_mul, mul_add] @@ -627,9 +562,7 @@ lemma superCommuteF_fermionic_bonsonic {a b : 𝓕.FieldOpFreeAlgebra} apply Submodule.span_induction (p := p) · intro x hx obtain ⟨φs', rfl, hφs'⟩ := hx - simp only [p] - rw [superCommuteF_ofCrAnListF_ofCrAnListF] - simp [hφs, hφs', ofCrAnListF_append] + simp [p, hφs, hφs', ofCrAnListF_append, superCommuteF_ofCrAnListF_ofCrAnListF] · simp [p] · intro x y hx hy hp1 hp2 simp_all only [p, map_add, LinearMap.add_apply, add_mul, mul_add] @@ -688,9 +621,7 @@ lemma superCommuteF_fermionic_fermionic {a b : 𝓕.FieldOpFreeAlgebra} apply Submodule.span_induction (p := p) · intro x hx obtain ⟨φs', rfl, hφs'⟩ := hx - simp only [p] - rw [superCommuteF_ofCrAnListF_ofCrAnListF] - simp [hφs, hφs', ofCrAnListF_append] + simp [p, hφs, hφs', ofCrAnListF_append, superCommuteF_ofCrAnListF_ofCrAnListF] · simp [p] · intro x y hx hy hp1 hp2 simp_all only [p, map_add, LinearMap.add_apply, add_mul, mul_add] @@ -731,37 +662,21 @@ lemma superCommuteF_ofCrAnListF_ofCrAnListF_bosonic_or_fermionic (φs φs' : Lis [ofCrAnListF φs, ofCrAnListF φs']ₛF ∈ statisticSubmodule fermionic := by by_cases h1 : (𝓕 |>ₛ φs) = bosonic <;> by_cases h2 : (𝓕 |>ₛ φs') = bosonic · left - have h : bosonic = bosonic + bosonic := by - simp only [add_eq_mul, mul_self] - rfl - rw [h] - apply superCommuteF_grade - apply ofCrAnListF_mem_statisticSubmodule_of _ _ h1 - apply ofCrAnListF_mem_statisticSubmodule_of _ _ h2 + rw [show bosonic = bosonic + bosonic from rfl] + exact superCommuteF_grade (ofCrAnListF_mem_statisticSubmodule_of _ _ h1) + (ofCrAnListF_mem_statisticSubmodule_of _ _ h2) · right - have h : fermionic = bosonic + fermionic := by - simp only [add_eq_mul] - rfl - rw [h] - apply superCommuteF_grade - apply ofCrAnListF_mem_statisticSubmodule_of _ _ h1 - apply ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h2) + rw [show fermionic = bosonic + fermionic from rfl] + exact superCommuteF_grade (ofCrAnListF_mem_statisticSubmodule_of _ _ h1) + (ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h2)) · right - have h : fermionic = fermionic + bosonic := by - simp only [add_eq_mul] - rfl - rw [h] - apply superCommuteF_grade - apply ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h1) - apply ofCrAnListF_mem_statisticSubmodule_of _ _ h2 + rw [show fermionic = fermionic + bosonic from rfl] + exact superCommuteF_grade (ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h1)) + (ofCrAnListF_mem_statisticSubmodule_of _ _ h2) · left - have h : bosonic = fermionic + fermionic := by - simp only [add_eq_mul, mul_self] - rfl - rw [h] - apply superCommuteF_grade - apply ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h1) - apply ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h2) + rw [show bosonic = fermionic + fermionic from rfl] + exact superCommuteF_grade (ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h1)) + (ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using h2)) lemma superCommuteF_ofCrAnOpF_ofCrAnOpF_bosonic_or_fermionic (φ φ' : 𝓕.CrAnFieldOp) : [ofCrAnOpF φ, ofCrAnOpF φ']ₛF ∈ statisticSubmodule bosonic ∨ @@ -775,29 +690,17 @@ lemma superCommuteF_superCommuteF_ofCrAnOpF_bosonic_or_fermionic (φ1 φ2 φ3 : rcases superCommuteF_ofCrAnOpF_ofCrAnOpF_bosonic_or_fermionic φ2 φ3 with hs | hs <;> rcases ofCrAnOpF_bosonic_or_fermionic φ1 with h1 | h1 · left - have h : bosonic = bosonic + bosonic := by - simp only [add_eq_mul, mul_self] - rfl - rw [h] - apply superCommuteF_grade h1 hs + rw [show bosonic = bosonic + bosonic from rfl] + exact superCommuteF_grade h1 hs · right - have h : fermionic = fermionic + bosonic := by - simp only [add_eq_mul] - rfl - rw [h] - apply superCommuteF_grade h1 hs + rw [show fermionic = fermionic + bosonic from rfl] + exact superCommuteF_grade h1 hs · right - have h : fermionic = bosonic + fermionic := by - simp only [add_eq_mul] - rfl - rw [h] - apply superCommuteF_grade h1 hs + rw [show fermionic = bosonic + fermionic from rfl] + exact superCommuteF_grade h1 hs · left - have h : bosonic = fermionic + fermionic := by - simp only [add_eq_mul, mul_self] - rfl - rw [h] - apply superCommuteF_grade h1 hs + rw [show bosonic = fermionic + fermionic from rfl] + exact superCommuteF_grade h1 hs lemma superCommuteF_bosonic_ofCrAnListF_eq_sum (a : 𝓕.FieldOpFreeAlgebra) (φs : List 𝓕.CrAnFieldOp) (ha : a ∈ statisticSubmodule bosonic) : @@ -871,24 +774,12 @@ lemma statistic_ne_of_superCommuteF_fermionic {φs φs' : List 𝓕.CrAnFieldOp} by_contra hn refine h0 (eq_zero_of_bosonic_and_fermionic ?_ h) by_cases hc : (𝓕 |>ₛ φs) = bosonic - · have h1 : bosonic = bosonic + bosonic := by - simp only [add_eq_mul, mul_self] - rfl - rw [h1] - apply superCommuteF_grade - apply ofCrAnListF_mem_statisticSubmodule_of _ _ hc - apply ofCrAnListF_mem_statisticSubmodule_of _ _ - rw [← hn, hc] - · have h1 : bosonic = fermionic + fermionic := by - simp only [add_eq_mul, mul_self] - rfl - rw [h1] - apply superCommuteF_grade - apply ofCrAnListF_mem_statisticSubmodule_of _ _ - simpa using hc - apply ofCrAnListF_mem_statisticSubmodule_of _ _ - rw [← hn] - simpa using hc + · rw [show bosonic = bosonic + bosonic from rfl] + exact superCommuteF_grade (ofCrAnListF_mem_statisticSubmodule_of _ _ hc) + (ofCrAnListF_mem_statisticSubmodule_of _ _ (by rw [← hn, hc])) + · rw [show bosonic = fermionic + fermionic from rfl] + exact superCommuteF_grade (ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa using hc)) + (ofCrAnListF_mem_statisticSubmodule_of _ _ (by simpa [← hn] using hc)) end FieldOpFreeAlgebra diff --git a/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean b/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean index 96b35b211..fa0f9b990 100644 --- a/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean +++ b/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean @@ -52,16 +52,13 @@ noncomputable instance : (φ φ' : 𝓕.FieldOp) → Decidable (timeOrderRel φ /-- Time ordering is total. -/ instance : Std.Total 𝓕.timeOrderRel where total a b := by - cases a <;> cases b <;> - simp only [or_self, or_false, or_true, timeOrderRel, Fin.isValue] - exact LinearOrder.le_total _ _ + cases a <;> cases b <;> simp [timeOrderRel, le_total] /-- Time ordering is transitive. -/ instance : IsTrans 𝓕.FieldOp 𝓕.timeOrderRel where trans a b c := by - cases a <;> cases b <;> cases c <;> - simp only [timeOrderRel, Fin.isValue, implies_true, imp_self, IsEmpty.forall_iff] - exact fun h1 h2 => Preorder.le_trans _ _ _ h2 h1 + cases a <;> cases b <;> cases c <;> simp [timeOrderRel] + exact fun h1 h2 => h2.trans h1 noncomputable section @@ -77,9 +74,8 @@ def maxTimeFieldPos (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : ℕ := insertionSortMinPos timeOrderRel φ φs lemma maxTimeFieldPos_lt_length (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : - maxTimeFieldPos φ φs < (φ :: φs).length := by - simp only [maxTimeFieldPos, List.length_cons, Order.lt_add_one_iff] - exact Fin.is_le (insertionSortMinPos timeOrderRel φ φs) + maxTimeFieldPos φ φs < (φ :: φs).length := + (insertionSortMinPos timeOrderRel φ φs).isLt /-- Given a list `φ :: φs` of states, the left-most state of maximum time, if there are more. As an example: @@ -105,8 +101,7 @@ lemma eraseMaxTimeField_length (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : lemma maxTimeFieldPos_lt_eraseMaxTimeField_length_succ (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : maxTimeFieldPos φ φs < (eraseMaxTimeField φ φs).length.succ := by - simp only [eraseMaxTimeField_length, Nat.succ_eq_add_one] - exact maxTimeFieldPos_lt_length φ φs + simpa using maxTimeFieldPos_lt_length φ φs /-- Given a list `φ :: φs` of states, the position of the left-most state of maximum time as an element of `Fin (eraseMaxTimeField φ φs).length.succ`. @@ -120,13 +115,13 @@ def maxTimeFieldPosFin (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : lemma lt_maxTimeFieldPosFin_not_timeOrder (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (i : Fin (eraseMaxTimeField φ φs).length) (hi : (maxTimeFieldPosFin φ φs).succAbove i < maxTimeFieldPosFin φ φs) : - ¬ timeOrderRel ((eraseMaxTimeField φ φs)[i.val]) (maxTimeField φ φs) := by - exact insertionSortMin_lt_mem_insertionSortDropMinPos_of_lt timeOrderRel φ φs i hi + ¬ timeOrderRel ((eraseMaxTimeField φ φs)[i.val]) (maxTimeField φ φs) := + insertionSortMin_lt_mem_insertionSortDropMinPos_of_lt timeOrderRel φ φs i hi lemma timeOrder_maxTimeField (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (i : Fin (eraseMaxTimeField φ φs).length) : - timeOrderRel (maxTimeField φ φs) ((eraseMaxTimeField φ φs)[i.val]) := by - exact insertionSortMin_lt_mem_insertionSortDropMinPos timeOrderRel φ φs _ + timeOrderRel (maxTimeField φ φs) ((eraseMaxTimeField φ φs)[i.val]) := + insertionSortMin_lt_mem_insertionSortDropMinPos timeOrderRel φ φs _ /-- The sign associated with putting a list of states into time order (with the state of greatest time to the left). @@ -136,27 +131,22 @@ def timeOrderSign (φs : List 𝓕.FieldOp) : ℂ := @[simp] lemma timeOrderSign_nil : timeOrderSign (𝓕 := 𝓕) [] = 1 := by - simp only [timeOrderSign] - rfl + simp [timeOrderSign, Wick.koszulSign] lemma timeOrderSign_pair_ordered {φ ψ : 𝓕.FieldOp} (h : timeOrderRel φ ψ) : timeOrderSign [φ, ψ] = 1 := by - simp only [timeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, mul_one, ite_eq_left_iff, - ite_eq_right_iff, and_imp] - exact fun h' => False.elim (h' h) + simp [timeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, h] lemma timeOrderSign_pair_not_ordered {φ ψ : 𝓕.FieldOp} (h : ¬ timeOrderRel φ ψ) : timeOrderSign [φ, ψ] = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ψ) := by - simp only [timeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, mul_one] - rw [if_neg h] - simp [FieldStatistic.exchangeSign_eq_if] + simp [timeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, h, + FieldStatistic.exchangeSign_eq_if] lemma timerOrderSign_of_eraseMaxTimeField (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : timeOrderSign (eraseMaxTimeField φ φs) = timeOrderSign (φ :: φs) * 𝓢(𝓕 |>ₛ maxTimeField φ φs, 𝓕 |>ₛ (φ :: φs).take (maxTimeFieldPos φ φs)) := by rw [eraseMaxTimeField, insertionSortDropMinPos, timeOrderSign, - Wick.koszulSign_eraseIdx_insertionSortMinPos] - rw [← timeOrderSign, ← maxTimeField] + Wick.koszulSign_eraseIdx_insertionSortMinPos, ← timeOrderSign, ← maxTimeField] rfl /-- The time ordering of a list of states. A schematic example is: @@ -167,23 +157,19 @@ def timeOrderList (φs : List 𝓕.FieldOp) : List 𝓕.FieldOp := lemma timeOrderList_pair_ordered {φ ψ : 𝓕.FieldOp} (h : timeOrderRel φ ψ) : timeOrderList [φ, ψ] = [φ, ψ] := by - simp only [timeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, - ite_eq_left_iff, List.cons.injEq, and_true] - exact fun h' => False.elim (h' h) + simp [timeOrderList, h] lemma timeOrderList_pair_not_ordered {φ ψ : 𝓕.FieldOp} (h : ¬ timeOrderRel φ ψ) : timeOrderList [φ, ψ] = [ψ, φ] := by - simp only [timeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, - ite_eq_right_iff, List.cons.injEq, and_true] - exact fun h' => False.elim (h h') + simp [timeOrderList, List.orderedInsert, h] @[simp] lemma timeOrderList_nil : timeOrderList (𝓕 := 𝓕) [] = [] := by simp [timeOrderList] lemma timeOrderList_eq_maxTimeField_timeOrderList (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : - timeOrderList (φ :: φs) = maxTimeField φ φs :: timeOrderList (eraseMaxTimeField φ φs) := by - exact insertionSort_eq_insertionSortMin_cons timeOrderRel φ φs + timeOrderList (φ :: φs) = maxTimeField φ φs :: timeOrderList (eraseMaxTimeField φ φs) := + insertionSort_eq_insertionSortMin_cons timeOrderRel φ φs /-! @@ -226,8 +212,8 @@ instance : IsTrans 𝓕.CrAnFieldOp 𝓕.crAnTimeOrderRel where trans a b c := IsTrans.trans (r := 𝓕.timeOrderRel) a.1 b.1 c.1 @[simp] -lemma crAnTimeOrderRel_refl (φ : 𝓕.CrAnFieldOp) : crAnTimeOrderRel φ φ := by - exact (Std.Total.to_refl (r := 𝓕.crAnTimeOrderRel)).refl φ +lemma crAnTimeOrderRel_refl (φ : 𝓕.CrAnFieldOp) : crAnTimeOrderRel φ φ := + (Std.Total.to_refl (r := 𝓕.crAnTimeOrderRel)).refl φ /-- For a field specification `𝓕`, and a list `φs` of `𝓕.CrAnFieldOp`, `𝓕.crAnTimeOrderSign φs` is the sign corresponding to the number of `ferimionic`-`fermionic` @@ -238,25 +224,21 @@ def crAnTimeOrderSign (φs : List 𝓕.CrAnFieldOp) : ℂ := @[simp] lemma crAnTimeOrderSign_nil : crAnTimeOrderSign (𝓕 := 𝓕) [] = 1 := by - simp only [crAnTimeOrderSign] - rfl + simp [crAnTimeOrderSign, Wick.koszulSign] lemma crAnTimeOrderSign_pair_ordered {φ ψ : 𝓕.CrAnFieldOp} (h : crAnTimeOrderRel φ ψ) : crAnTimeOrderSign [φ, ψ] = 1 := by - simp only [crAnTimeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, mul_one, ite_eq_left_iff, - ite_eq_right_iff, and_imp] - exact fun h' => False.elim (h' h) + simp [crAnTimeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, h] lemma crAnTimeOrderSign_pair_not_ordered {φ ψ : 𝓕.CrAnFieldOp} (h : ¬ crAnTimeOrderRel φ ψ) : crAnTimeOrderSign [φ, ψ] = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ψ) := by - simp only [crAnTimeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, mul_one] - rw [if_neg h] - simp [FieldStatistic.exchangeSign_eq_if] + simp [crAnTimeOrderSign, Wick.koszulSign, Wick.koszulSignInsert, h, + FieldStatistic.exchangeSign_eq_if] lemma crAnTimeOrderSign_swap_eq_time {φ ψ : 𝓕.CrAnFieldOp} (h1 : crAnTimeOrderRel φ ψ) (h2 : crAnTimeOrderRel ψ φ) (φs φs' : List 𝓕.CrAnFieldOp) : - crAnTimeOrderSign (φs ++ φ :: ψ :: φs') = crAnTimeOrderSign (φs ++ ψ :: φ :: φs') := by - exact Wick.koszulSign_swap_eq_rel _ _ h1 h2 _ _ + crAnTimeOrderSign (φs ++ φ :: ψ :: φs') = crAnTimeOrderSign (φs ++ ψ :: φ :: φs') := + Wick.koszulSign_swap_eq_rel _ _ h1 h2 _ _ /-- For a field specification `𝓕`, and a list `φs` of `𝓕.CrAnFieldOp`, `𝓕.crAnTimeOrderList φs` is the list `φs` time-ordered using the insertion sort algorithm. -/ @@ -269,39 +251,21 @@ lemma crAnTimeOrderList_nil : crAnTimeOrderList (𝓕 := 𝓕) [] = [] := by lemma crAnTimeOrderList_pair_ordered {φ ψ : 𝓕.CrAnFieldOp} (h : crAnTimeOrderRel φ ψ) : crAnTimeOrderList [φ, ψ] = [φ, ψ] := by - simp only [crAnTimeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, - ite_eq_left_iff, List.cons.injEq, and_true] - exact fun h' => False.elim (h' h) + simp [crAnTimeOrderList, h] lemma crAnTimeOrderList_pair_not_ordered {φ ψ : 𝓕.CrAnFieldOp} (h : ¬ crAnTimeOrderRel φ ψ) : crAnTimeOrderList [φ, ψ] = [ψ, φ] := by - simp only [crAnTimeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, - ite_eq_right_iff, List.cons.injEq, and_true] - exact fun h' => False.elim (h h') + simp [crAnTimeOrderList, List.orderedInsert, h] lemma orderedInsert_swap_eq_time {φ ψ : 𝓕.CrAnFieldOp} (h1 : crAnTimeOrderRel φ ψ) (h2 : crAnTimeOrderRel ψ φ) (φs : List 𝓕.CrAnFieldOp) : List.orderedInsert crAnTimeOrderRel φ (List.orderedInsert crAnTimeOrderRel ψ φs) = List.takeWhile (fun b => ¬ crAnTimeOrderRel ψ b) φs ++ φ :: ψ :: List.dropWhile (fun b => ¬ crAnTimeOrderRel ψ b) φs := by - rw [List.orderedInsert_eq_take_drop crAnTimeOrderRel ψ φs] - simp only [decide_not] - rw [List.orderedInsert_eq_take_drop] - simp only [decide_not] + rw [List.orderedInsert_eq_take_drop crAnTimeOrderRel ψ φs, List.orderedInsert_eq_take_drop] have h1 (b : 𝓕.CrAnFieldOp) : (crAnTimeOrderRel φ b) ↔ (crAnTimeOrderRel ψ b) := Iff.intro (fun h => IsTrans.trans _ _ _ h2 h) (fun h => IsTrans.trans _ _ _ h1 h) - simp only [h1] - rw [List.takeWhile_append] - rw [List.takeWhile_takeWhile] - simp only [Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not, and_self, decide_not, - ↓reduceIte, crAnTimeOrderRel_refl, decide_true, Bool.false_eq_true, not_false_eq_true, - List.takeWhile_cons_of_neg, List.append_nil, List.append_cancel_left_eq, List.cons.injEq, - true_and] - rw [List.dropWhile_append] - simp only [List.isEmpty_iff, List.dropWhile_eq_nil_iff, Bool.not_eq_eq_eq_not, Bool.not_true, - decide_eq_false_iff_not, crAnTimeOrderRel_refl, decide_true, Bool.false_eq_true, - not_false_eq_true, List.dropWhile_cons_of_neg, ite_eq_left_iff, not_forall, Decidable.not_not, - List.append_left_eq_self, forall_exists_index] + simp [h1, List.takeWhile_append, List.takeWhile_takeWhile, List.dropWhile_append] intro x hx hxψ y hy simpa using List.mem_takeWhile_imp hy @@ -312,24 +276,21 @@ lemma orderedInsert_in_swap_eq_time {φ ψ φ': 𝓕.CrAnFieldOp} (h1 : crAnTime | [], φs' => by have h1 (b : 𝓕.CrAnFieldOp) : (crAnTimeOrderRel b φ) ↔ (crAnTimeOrderRel b ψ) := Iff.intro (fun h => IsTrans.trans _ _ _ h h1) (fun h => IsTrans.trans _ _ _ h h2) + simp only [List.nil_append, List.orderedInsert, ← h1 φ'] by_cases h : crAnTimeOrderRel φ' φ - · simp only [List.nil_append, List.orderedInsert, h, ↓reduceIte, ← h1 φ'] - use [φ'], φs' - simp - · simp only [List.nil_append, List.orderedInsert, h, ↓reduceIte, ← h1 φ'] - use [], List.orderedInsert crAnTimeOrderRel φ' φs' - simp + · use [φ'], φs' + simp [h] + · use [], List.orderedInsert crAnTimeOrderRel φ' φs' + simp [h] | φ'' :: φs, φs' => by obtain ⟨l1, l2, hl⟩ := orderedInsert_in_swap_eq_time (φ' := φ') h1 h2 φs φs' simp only [List.cons_append, List.orderedInsert] rw [hl.1, hl.2] by_cases h : crAnTimeOrderRel φ' φ'' - · simp only [h, ↓reduceIte] - use (φ' :: φ'' :: φs), φs' - simp - · simp only [h, ↓reduceIte] - use (φ'' :: l1), l2 - simp + · use φ' :: φ'' :: φs, φs' + simp [h] + · use φ'' :: l1, l2 + simp [h] lemma crAnTimeOrderList_swap_eq_time {φ ψ : 𝓕.CrAnFieldOp} (h1 : crAnTimeOrderRel φ ψ) (h2 : crAnTimeOrderRel ψ φ) : @@ -338,27 +299,16 @@ lemma crAnTimeOrderList_swap_eq_time {φ ψ : 𝓕.CrAnFieldOp} crAnTimeOrderList (φs ++ φ :: ψ :: φs') = l1 ++ φ :: ψ :: l2 ∧ crAnTimeOrderList (φs ++ ψ :: φ :: φs') = l1 ++ ψ :: φ :: l2 | [], φs' => by - simp only [crAnTimeOrderList] - simp only [List.nil_append, List.insertionSort] - use List.takeWhile (fun b => ¬ crAnTimeOrderRel ψ b) (List.insertionSort crAnTimeOrderRel φs'), - List.dropWhile (fun b => ¬ crAnTimeOrderRel ψ b) (List.insertionSort crAnTimeOrderRel φs') - apply And.intro - · exact orderedInsert_swap_eq_time h1 h2 _ - · have h1' (b : 𝓕.CrAnFieldOp) : (crAnTimeOrderRel φ b) ↔ (crAnTimeOrderRel ψ b) := - Iff.intro (fun h => IsTrans.trans _ _ _ h2 h) (fun h => IsTrans.trans _ _ _ h1 h) - simp only [← h1', decide_not] - have h2 := orderedInsert_swap_eq_time h2 h1 - simp_all - exact (List.append_left_inj _).mpr rfl + simp only [crAnTimeOrderList, List.nil_append, List.insertionSort] + refine ⟨_, _, orderedInsert_swap_eq_time h1 h2 _, ?_⟩ + have h1' (b : 𝓕.CrAnFieldOp) : (crAnTimeOrderRel φ b) ↔ (crAnTimeOrderRel ψ b) := + Iff.intro (fun h => IsTrans.trans _ _ _ h2 h) (fun h => IsTrans.trans _ _ _ h1 h) + simpa only [← h1', decide_not, List.foldr_cons] using orderedInsert_swap_eq_time h2 h1 _ | φ'' :: φs, φs' => by - rw [crAnTimeOrderList, crAnTimeOrderList] - simp only [List.cons_append, List.insertionSort_cons] obtain ⟨l1, l2, hl⟩ := crAnTimeOrderList_swap_eq_time h1 h2 φs φs' - simp only [crAnTimeOrderList] at hl + simp only [crAnTimeOrderList, List.cons_append, List.insertionSort_cons] at hl ⊢ rw [hl.1, hl.2] - obtain ⟨l1', l2', hl'⟩ := orderedInsert_in_swap_eq_time (φ' := φ'') h1 h2 l1 l2 - rw [hl'.1, hl'.2] - use l1', l2' + exact orderedInsert_in_swap_eq_time (φ' := φ'') h1 h2 l1 l2 /-! @@ -372,17 +322,12 @@ lemma koszulSignInsert_crAnTimeOrderRel_crAnSection {φ : 𝓕.FieldOp} {ψ : | [], ⟨[], h⟩ => by simp [Wick.koszulSignInsert] | φ' :: φs, ⟨ψ' :: ψs, h1⟩ => by - simp only [Wick.koszulSignInsert, crAnTimeOrderRel, h] simp only [List.map_cons, List.cons.injEq] at h1 - have hi := koszulSignInsert_crAnTimeOrderRel_crAnSection h (φs := φs) ⟨ψs, h1.2⟩ - rw [hi] - congr - · exact h1.1 - · simp only [crAnStatistics, crAnFieldOpToFieldOp, Function.comp_apply] - congr - · simp only [crAnStatistics, crAnFieldOpToFieldOp, Function.comp_apply] - congr - exact h1.1 + obtain ⟨rfl, h2⟩ := h1 + subst h + simp only [Wick.koszulSignInsert, + koszulSignInsert_crAnTimeOrderRel_crAnSection (ψ := ψ) rfl ⟨ψs, h2⟩] + rfl @[simp] lemma crAnTimeOrderSign_crAnSection : {φs : List 𝓕.FieldOp} → (ψs : CrAnSection φs) → @@ -390,44 +335,32 @@ lemma crAnTimeOrderSign_crAnSection : {φs : List 𝓕.FieldOp} → (ψs : CrAnS | [], ⟨[], h⟩ => by simp | φ :: φs, ⟨ψ :: ψs, h⟩ => by - simp only [crAnTimeOrderSign, Wick.koszulSign, timeOrderSign] simp only [List.map_cons, List.cons.injEq] at h - congr 1 - · rw [koszulSignInsert_crAnTimeOrderRel_crAnSection h.1 ⟨ψs, h.2⟩] - · exact crAnTimeOrderSign_crAnSection ⟨ψs, h.2⟩ + exact congrArg₂ (· * ·) (koszulSignInsert_crAnTimeOrderRel_crAnSection h.1 ⟨ψs, h.2⟩) + (crAnTimeOrderSign_crAnSection ⟨ψs, h.2⟩) lemma orderedInsert_crAnTimeOrderRel_crAnSection {φ : 𝓕.FieldOp} {ψ : 𝓕.CrAnFieldOp} (h : ψ.1 = φ) : {φs : List 𝓕.FieldOp} → (ψs : CrAnSection φs) → (List.orderedInsert 𝓕.crAnTimeOrderRel ψ ψs.1).map 𝓕.crAnFieldOpToFieldOp = List.orderedInsert 𝓕.timeOrderRel φ φs | [], ⟨[], _⟩ => by - simp only [List.orderedInsert, List.map_cons, List.map_nil, List.cons.injEq, and_true] - exact h + simp [crAnFieldOpToFieldOp, h] | φ' :: φs, ⟨ψ' :: ψs, h1⟩ => by - simp only [List.orderedInsert, crAnTimeOrderRel, h] simp only [List.map_cons, List.cons.injEq] at h1 - by_cases hr : timeOrderRel φ φ' - · simp only [hr, ↓reduceIte] - rw [← h1.1] at hr - simp only [crAnFieldOpToFieldOp] at hr - simp only [hr, ↓reduceIte, List.map_cons, List.cons.injEq] - exact And.intro h (And.intro h1.1 h1.2) - · simp only [hr, ↓reduceIte] - rw [← h1.1] at hr - simp only [crAnFieldOpToFieldOp] at hr - simp only [hr, ↓reduceIte, List.map_cons, List.cons.injEq] - apply And.intro h1.1 - exact orderedInsert_crAnTimeOrderRel_crAnSection h ⟨ψs, h1.2⟩ + obtain ⟨rfl, h2⟩ := h1 + rw [crAnFieldOpToFieldOp] at h2 + have ih := orderedInsert_crAnTimeOrderRel_crAnSection h ⟨ψs, h2⟩ + by_cases hr : crAnTimeOrderRel ψ ψ' <;> + simp_all [crAnTimeOrderRel, crAnFieldOpToFieldOp] lemma crAnTimeOrderList_crAnSection_is_crAnSection : {φs : List 𝓕.FieldOp} → (ψs : CrAnSection φs) → (crAnTimeOrderList ψs.1).map 𝓕.crAnFieldOpToFieldOp = timeOrderList φs | [], ⟨[], h⟩ => by simp | φ :: φs, ⟨ψ :: ψs, h⟩ => by - simp only [crAnTimeOrderList, List.insertionSort, timeOrderList] simp only [List.map_cons, List.cons.injEq] at h - exact orderedInsert_crAnTimeOrderRel_crAnSection h.1 ⟨(List.insertionSort crAnTimeOrderRel ψs), - crAnTimeOrderList_crAnSection_is_crAnSection ⟨ψs, h.2⟩⟩ + exact orderedInsert_crAnTimeOrderRel_crAnSection h.1 + ⟨_, crAnTimeOrderList_crAnSection_is_crAnSection ⟨ψs, h.2⟩⟩ /-- Time ordering of sections of a list of states. -/ def crAnSectionTimeOrder (φs : List 𝓕.FieldOp) (ψs : CrAnSection φs) : @@ -440,37 +373,19 @@ lemma orderedInsert_crAnTimeOrderRel_injective {ψ ψ' : 𝓕.CrAnFieldOp} (h : (ho : List.orderedInsert crAnTimeOrderRel ψ ψs.1 = List.orderedInsert crAnTimeOrderRel ψ' ψs'.1) → ψ = ψ' ∧ ψs = ψs' | [], ⟨[], _⟩, ⟨[], _⟩, h => by - simp only [List.orderedInsert, List.cons.injEq, and_true] at h simpa using h | φ :: φs, ⟨ψ1 :: ψs, h1⟩, ⟨ψ1' :: ψs', h1'⟩, ho => by simp only [List.map_cons, List.cons.injEq] at h1 h1' - have ih := orderedInsert_crAnTimeOrderRel_injective h ⟨ψs, h1.2⟩ ⟨ψs', h1'.2⟩ + have key : crAnTimeOrderRel ψ ψ1 ↔ crAnTimeOrderRel ψ' ψ1' := by + rw [crAnFieldOpToFieldOp] at h1 h1' + simp only [crAnTimeOrderRel, h, h1.1, h1'.1] simp only [List.orderedInsert] at ho by_cases hr : crAnTimeOrderRel ψ ψ1 - · simp_all only [ite_true] - by_cases hr2 : crAnTimeOrderRel ψ' ψ1' - · simp_all - · simp only [crAnTimeOrderRel] at hr hr2 - simp_all only - rw [crAnFieldOpToFieldOp] at h1 h1' - rw [h1.1] at hr - rw [h1'.1] at hr2 - exact False.elim (hr2 hr) - · simp_all only [ite_false] - by_cases hr2 : crAnTimeOrderRel ψ' ψ1' - · simp only [crAnTimeOrderRel] at hr hr2 - simp_all only - rw [crAnFieldOpToFieldOp] at h1 h1' - rw [h1.1] at hr - rw [h1'.1] at hr2 - exact False.elim (hr hr2) - · simp only [hr2, ↓reduceIte, List.cons.injEq] at ho - have ih' := ih ho.2 - simp_all only [and_self, implies_true, not_false_eq_true, true_and] - apply Subtype.ext - simp only [List.cons.injEq, true_and] - rw [Subtype.ext_iff] at ih' - exact ih'.2 + · simp_all + · simp only [hr, key.not.mp hr, ↓reduceIte, List.cons.injEq] at ho + obtain ⟨rfl, ho2⟩ := ho + obtain ⟨rfl, hs⟩ := orderedInsert_crAnTimeOrderRel_injective h ⟨ψs, h1.2⟩ ⟨ψs', h1'.2⟩ ho2 + exact ⟨rfl, Subtype.ext (congrArg (ψ1 :: ·) (Subtype.ext_iff.mp hs))⟩ set_option backward.isDefEq.respectTransparency false in lemma crAnSectionTimeOrder_injective : {φs : List 𝓕.FieldOp} → @@ -481,30 +396,23 @@ lemma crAnSectionTimeOrder_injective : {φs : List 𝓕.FieldOp} → intro h1 apply Subtype.ext simp only [List.cons.injEq] - simp only [crAnSectionTimeOrder] at h1 rw [Subtype.ext_iff] at h1 - simp only [crAnTimeOrderList, List.insertionSort] at h1 + simp only [crAnSectionTimeOrder, crAnTimeOrderList, List.insertionSort] at h1 simp only [List.map_cons, List.cons.injEq] at h h' rw [crAnFieldOpToFieldOp] at h h' - have hin := orderedInsert_crAnTimeOrderRel_injective (by rw [h.1, h'.1]) + have hin := orderedInsert_crAnTimeOrderRel_injective (h.1.trans h'.1.symm) (𝓕.crAnSectionTimeOrder φs ⟨ψs, h.2⟩) (𝓕.crAnSectionTimeOrder φs ⟨ψs', h'.2⟩) h1 - apply And.intro hin.1 - have hl := crAnSectionTimeOrder_injective hin.2 - rw [Subtype.ext_iff] at hl - simpa using hl + exact ⟨hin.1, congrArg Subtype.val (crAnSectionTimeOrder_injective hin.2)⟩ lemma crAnSectionTimeOrder_bijective (φs : List 𝓕.FieldOp) : - Function.Bijective (𝓕.crAnSectionTimeOrder φs) := by - rw [Fintype.bijective_iff_injective_and_card] - apply And.intro crAnSectionTimeOrder_injective - apply CrAnSection.card_perm_eq - simp only [timeOrderList] - exact List.Perm.symm (List.perm_insertionSort timeOrderRel φs) + Function.Bijective (𝓕.crAnSectionTimeOrder φs) := + (Fintype.bijective_iff_injective_and_card _).mpr ⟨crAnSectionTimeOrder_injective, + CrAnSection.card_perm_eq (List.perm_insertionSort timeOrderRel φs).symm⟩ lemma sum_crAnSections_timeOrder {φs : List 𝓕.FieldOp} [AddCommMonoid M] - (f : CrAnSection (timeOrderList φs) → M) : ∑ s, f s = ∑ s, f (𝓕.crAnSectionTimeOrder φs s) := by - erw [(Equiv.ofBijective _ (𝓕.crAnSectionTimeOrder_bijective φs)).sum_comp] + (f : CrAnSection (timeOrderList φs) → M) : ∑ s, f s = ∑ s, f (𝓕.crAnSectionTimeOrder φs s) := + ((Equiv.ofBijective _ (𝓕.crAnSectionTimeOrder_bijective φs)).sum_comp f).symm /-! @@ -525,33 +433,18 @@ noncomputable instance (φ φ' : 𝓕.CrAnFieldOp) : Decidable (normTimeOrderRel /-- Norm-Time ordering of `CrAnFieldOp` is total. -/ instance : Std.Total 𝓕.normTimeOrderRel where total a b := by + have h1 := Std.Total.total (r := 𝓕.crAnTimeOrderRel) a b + have h2 := Std.Total.total (r := 𝓕.normalOrderRel) a b simp only [normTimeOrderRel] - match Std.Total.total (r := 𝓕.crAnTimeOrderRel) a b, - Std.Total.total (r := 𝓕.normalOrderRel) a b with - | Or.inl h1, Or.inl h2 => simp [h1, h2] - | Or.inr h1, Or.inl h2 => - simp only [h1, h2, imp_self, and_true, true_and] - by_cases hn : crAnTimeOrderRel a b - · simp [hn] - · simp [hn] - | Or.inl h1, Or.inr h2 => - simp only [h1, true_and, h2, imp_self, and_true] - by_cases hn : crAnTimeOrderRel b a - · simp [hn] - · simp [hn] - | Or.inr h1, Or.inr h2 => simp [h1, h2] + tauto /-- Norm-Time ordering of `CrAnFieldOp` is transitive. -/ instance : IsTrans 𝓕.CrAnFieldOp 𝓕.normTimeOrderRel where trans a b c := by intro h1 h2 simp_all only [normTimeOrderRel] - apply And.intro - · exact IsTrans.trans _ _ _ h1.1 h2.1 - · intro hc - refine IsTrans.trans _ _ _ (h1.2 ?_) (h2.2 ?_) - · exact IsTrans.trans _ _ _ h2.1 hc - · exact IsTrans.trans _ _ _ hc h1.1 + exact ⟨IsTrans.trans _ _ _ h1.1 h2.1, fun hc => IsTrans.trans _ _ _ + (h1.2 (IsTrans.trans _ _ _ h2.1 hc)) (h2.2 (IsTrans.trans _ _ _ hc h1.1))⟩ /-- The sign associated with putting a list of `CrAnFieldOp` into normal-time order (with the state of greatest time to the left). diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean index 6fe714d63..e19c3f6c1 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean @@ -48,8 +48,7 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp rw [ofFieldOpList_normalOrder_insert φ [φsΛ]ᵘᶜ ⟨(φsΛ.uncontractedListOrderPos i), by simp [uncontractedListGet]⟩, smul_smul] - trans (1 : ℂ) • (𝓝(ofFieldOpList [φsΛ ↩Λ φ i none]ᵘᶜ)) - · simp + refine (one_smul ℂ _).symm.trans ?_ congr 1 simp only [uncontractedListGet] rw [← List.map_take, take_uncontractedListOrderPos_eq_filter] @@ -59,11 +58,11 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp congr rw [uncontractedList_eq_sort] have hdup : (List.filter (fun x => decide (x.1 < i.1)) - (φsΛ.uncontracted.sort (fun x1 x2 => x1 ≤ x2))).Nodup := by - exact List.Nodup.filter _ (φsΛ.uncontracted.sort_nodup (fun x1 x2 => x1 ≤ x2)) + (φsΛ.uncontracted.sort (fun x1 x2 => x1 ≤ x2))).Nodup := + List.Nodup.filter _ (φsΛ.uncontracted.sort_nodup (fun x1 x2 => x1 ≤ x2)) have hsort : (List.filter (fun x => decide (x.1 < i.1)) - (φsΛ.uncontracted.sort (fun x1 x2 => x1 ≤ x2))).Pairwise (· ≤ ·) := by - exact List.Pairwise.filter _ (φsΛ.uncontracted.pairwise_sort (fun x1 x2 => x1 ≤ x2)) + (φsΛ.uncontracted.sort (fun x1 x2 => x1 ≤ x2))).Pairwise (· ≤ ·) := + List.Pairwise.filter _ (φsΛ.uncontracted.pairwise_sort (fun x1 x2 => x1 ≤ x2)) rw [← (List.toFinset_sort (· ≤ ·) hdup).mpr hsort] congr ext a @@ -72,36 +71,11 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp simp only [Nat.succ_eq_add_one] have h2 : (Finset.filter (fun x => x.1 < i.1) φsΛ.uncontracted) = (Finset.filter (fun x => i.succAbove x < i) φsΛ.uncontracted) := by - ext a - simp only [Nat.succ_eq_add_one, Finset.mem_filter, and_congr_right_iff] - intro ha - simp only [Fin.succAbove] - split - · apply Iff.intro - · intro h - omega - · intro h - rename_i h - rw [Fin.lt_def] at h - simp only [Fin.val_castSucc] at h - omega - · apply Iff.intro - · intro h - rename_i h' - rw [Fin.lt_def] - simp only [Fin.val_succ] - rw [Fin.lt_def] at h' - simp only [Fin.val_castSucc, not_lt] at h' - omega - · intro h - rename_i h - rw [Fin.lt_def] at h - simp only [Fin.val_succ] at h - omega + refine Finset.filter_congr fun a _ => ?_ + rw [Fin.succAbove_lt_iff_castSucc_lt, Fin.lt_def, Fin.val_castSucc] rw [h2] simp only [exchangeSign_mul_self] congr - simp only [Nat.succ_eq_add_one] rw [insertAndContract_uncontractedList_none_map] /-- diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean index eccba3f53..5c1211c78 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean @@ -58,10 +58,8 @@ lemma staticWickTerm_insert_zero_none (φ : 𝓕.FieldOp) (φs : List 𝓕.Field (φsΛ : WickContraction φs.length) : (φsΛ ↩Λ φ 0 none).staticWickTerm = φsΛ.sign • φsΛ.staticContract * 𝓝(ofFieldOpList (φ :: [φsΛ]ᵘᶜ)) := by - symm - erw [staticWickTerm, sign_insert_none_zero] - simp only [staticContract_insert_none, insertAndContract_uncontractedList_none_zero, - Algebra.smul_mul_assoc] + simp only [staticWickTerm, sign_insert_none_zero, staticContract_insert_none, + insertAndContract_uncontractedList_none_zero, Algebra.smul_mul_assoc] /-- For a list `φs = φ₀…φₙ` of `𝓕.FieldOp`, a Wick contraction `φsΛ` of `φs`, an element `φ` of `𝓕.FieldOp`, and a `k` in `φsΛ.uncontracted`, `(φsΛ ↩Λ φ 0 (some k)).wickTerm` is equal @@ -89,21 +87,16 @@ lemma staticWickTerm_insert_zero_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Field simp only [← mul_assoc] rw [← smul_mul_assoc] congr 1 - rw [staticContract_insert_some_of_lt] - swap - · simp - rw [smul_smul] + rw [staticContract_insert_some_of_lt (hik := by simp), smul_smul] by_cases hn : GradingCompliant φs φsΛ ∧ (𝓕|>ₛφ) = (𝓕|>ₛ φs[k.1]) · congr 1 - swap - · rw [Subalgebra.mem_center_iff.mp φsΛ.staticContract.2] · rw [sign_insert_some_zero _ _ _ _ hn, mul_comm, ← mul_assoc] simp + · rw [Subalgebra.mem_center_iff.mp φsΛ.staticContract.2] · simp only [Fin.getElem_fin, not_and] at hn by_cases h0 : ¬ GradingCompliant φs φsΛ - · rw [staticContract_of_not_gradingCompliant] + · rw [staticContract_of_not_gradingCompliant _ _ h0] simp only [ZeroMemClass.coe_zero, zero_mul, smul_zero, mul_zero] - exact h0 · simp_all only [not_not, forall_const] have h1 : contractStateAtIndex φ [φsΛ]ᵘᶜ (uncontractedFieldOpEquiv φs φsΛ k) = 0 := by simp only [contractStateAtIndex, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, @@ -112,10 +105,8 @@ lemma staticWickTerm_insert_zero_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Field right simp only [uncontractedListGet, List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem] - rw [superCommute_anPart_ofFieldOpF_diff_grade_zero] - exact hn - rw [h1] - simp + rw [superCommute_anPart_ofFieldOpF_diff_grade_zero (h := hn)] + simp [h1] set_option backward.isDefEq.respectTransparency false in /-- @@ -141,9 +132,8 @@ lemma mul_staticWickTerm_eq_sum (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ.staticContract).2 φsΛ.sign) conv_rhs => rw [← mul_assoc, ← ht] simp [mul_assoc, staticWickTerm] - rw [ofFieldOp_mul_normalOrder_ofFieldOpList_eq_sum] - rw [Finset.mul_sum] - rw [uncontractedFieldOpEquiv_list_sum] + rw [ofFieldOp_mul_normalOrder_ofFieldOpList_eq_sum, Finset.mul_sum, + uncontractedFieldOpEquiv_list_sum] refine Finset.sum_congr rfl (fun n _ => ?_) match n with | none => diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean index 34ced8b47..4f97eb25b 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean @@ -24,15 +24,13 @@ variable {𝓕 : FieldSpecification} lemma ι_superCommuteF_eq_zero_of_ι_right_zero (a b : 𝓕.FieldOpFreeAlgebra) (h : ι b = 0) : ι [a, b]ₛF = 0 := by - rw [superCommuteF_expand_bosonicProjF_fermionicProjF] - rw [ι_eq_zero_iff_ι_bosonicProjF_fermonicProj_zero] at h - simp_all + obtain ⟨h1, h2⟩ := (ι_eq_zero_iff_ι_bosonicProjF_fermonicProj_zero b).mp h + simp [superCommuteF_expand_bosonicProjF_fermionicProjF, h1, h2] lemma ι_superCommuteF_eq_zero_of_ι_left_zero (a b : 𝓕.FieldOpFreeAlgebra) (h : ι a = 0) : ι [a, b]ₛF = 0 := by - rw [superCommuteF_expand_bosonicProjF_fermionicProjF] - rw [ι_eq_zero_iff_ι_bosonicProjF_fermonicProj_zero] at h - simp_all + obtain ⟨h1, h2⟩ := (ι_eq_zero_iff_ι_bosonicProjF_fermonicProj_zero a).mp h + simp [superCommuteF_expand_bosonicProjF_fermionicProjF, h1, h2] /-! @@ -41,15 +39,13 @@ lemma ι_superCommuteF_eq_zero_of_ι_left_zero (a b : 𝓕.FieldOpFreeAlgebra) ( -/ lemma ι_superCommuteF_right_zero_of_mem_ideal (a b : 𝓕.FieldOpFreeAlgebra) - (h : b ∈ TwoSidedIdeal.span 𝓕.fieldOpIdealSet) : ι [a, b]ₛF = 0 := by - apply ι_superCommuteF_eq_zero_of_ι_right_zero - exact (ι_eq_zero_iff_mem_ideal b).mpr h + (h : b ∈ TwoSidedIdeal.span 𝓕.fieldOpIdealSet) : ι [a, b]ₛF = 0 := + ι_superCommuteF_eq_zero_of_ι_right_zero a b ((ι_eq_zero_iff_mem_ideal b).mpr h) lemma ι_superCommuteF_eq_of_equiv_right (a b1 b2 : 𝓕.FieldOpFreeAlgebra) (h : b1 ≈ b2) : ι [a, b1]ₛF = ι [a, b2]ₛF := by - rw [equiv_iff_sub_mem_ideal] at h - rw [← sub_eq_zero, ← map_sub, ← LinearMap.map_sub] - exact ι_superCommuteF_right_zero_of_mem_ideal a (b1 - b2) h + rw [← sub_eq_zero, ← map_sub, ← map_sub] + exact ι_superCommuteF_right_zero_of_mem_ideal a _ ((equiv_iff_sub_mem_ideal _ _).mp h) /-- The super commutator on the `WickAlgebra` defined as a linear map `[a,_]ₛ`. -/ noncomputable def superCommuteRight (a : 𝓕.FieldOpFreeAlgebra) : @@ -77,18 +73,11 @@ lemma superCommuteRight_apply_quot (a b : 𝓕.FieldOpFreeAlgebra) : lemma superCommuteRight_eq_of_equiv (a1 a2 : 𝓕.FieldOpFreeAlgebra) (h : a1 ≈ a2) : superCommuteRight a1 = superCommuteRight a2 := by - rw [equiv_iff_sub_mem_ideal] at h ext b obtain ⟨b, rfl⟩ := ι_surjective b - have ha1b1 : (superCommuteRight (a1 - a2)) (ι b) = 0 := by - rw [superCommuteRight_apply_ι] - apply ι_superCommuteF_eq_zero_of_ι_left_zero - exact (ι_eq_zero_iff_mem_ideal (a1 - a2)).mpr h - simp_all only [superCommuteRight_apply_ι, map_sub, LinearMap.sub_apply] - trans ι ((superCommuteF a2) b) + 0 - rw [← ha1b1] - simp only [add_sub_cancel] - simp + simpa [superCommuteRight_apply_ι, sub_eq_zero] using + ι_superCommuteF_eq_zero_of_ι_left_zero (a1 - a2) b + ((ι_eq_zero_iff_mem_ideal _).mpr ((equiv_iff_sub_mem_ideal _ _).mp h)) /-- For a field specification `𝓕`, `superCommute` is the linear map @@ -144,78 +133,55 @@ lemma superCommute_eq_ι_superCommuteF (a b : 𝓕.FieldOpFreeAlgebra) : lemma superCommute_create_create {φ φ' : 𝓕.CrAnFieldOp} (h : 𝓕 |>ᶜ φ = .create) (h' : 𝓕 |>ᶜ φ' = .create) : - [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := by - rw [ofCrAnOp, ofCrAnOp] - rw [superCommute_eq_ι_superCommuteF, ι_superCommuteF_of_create_create _ _ h h'] + [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := + ι_superCommuteF_of_create_create _ _ h h' lemma superCommute_annihilate_annihilate {φ φ' : 𝓕.CrAnFieldOp} (h : 𝓕 |>ᶜ φ = .annihilate) (h' : 𝓕 |>ᶜ φ' = .annihilate) : - [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := by - rw [ofCrAnOp, ofCrAnOp] - rw [superCommute_eq_ι_superCommuteF, ι_superCommuteF_of_annihilate_annihilate _ _ h h'] + [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := + ι_superCommuteF_of_annihilate_annihilate _ _ h h' lemma superCommute_diff_statistic {φ φ' : 𝓕.CrAnFieldOp} (h : (𝓕 |>ₛ φ) ≠ 𝓕 |>ₛ φ') : - [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := by - rw [ofCrAnOp, ofCrAnOp] - rw [superCommute_eq_ι_superCommuteF, ι_superCommuteF_of_diff_statistic h] + [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := + ι_superCommuteF_of_diff_statistic h lemma superCommute_ofCrAnOp_ofFieldOp_diff_stat_zero (φ : 𝓕.CrAnFieldOp) (ψ : 𝓕.FieldOp) (h : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ)) : [ofCrAnOp φ, ofFieldOp ψ]ₛ = 0 := by rw [ofFieldOp_eq_sum, map_sum] - rw [Finset.sum_eq_zero] - intro x hx - apply superCommute_diff_statistic + refine Finset.sum_eq_zero fun x _ => superCommute_diff_statistic ?_ simpa [crAnStatistics] using h lemma superCommute_anPart_ofFieldOpF_diff_grade_zero (φ ψ : 𝓕.FieldOp) (h : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ)) : [anPart φ, ofFieldOp ψ]ₛ = 0 := by - match φ with - | FieldOp.inAsymp _ => - simp - | FieldOp.position φ => - apply superCommute_ofCrAnOp_ofFieldOp_diff_stat_zero _ _ _ - simpa [crAnStatistics] using h - | FieldOp.outAsymp _ => - apply superCommute_ofCrAnOp_ofFieldOp_diff_stat_zero _ _ - simpa [crAnStatistics] using h + cases φ + · simp + all_goals + exact superCommute_ofCrAnOp_ofFieldOp_diff_stat_zero _ _ (by simpa [crAnStatistics] using h) lemma superCommute_ofCrAnOp_ofCrAnOp_mem_center (φ φ' : 𝓕.CrAnFieldOp) : - [ofCrAnOp φ, ofCrAnOp φ']ₛ ∈ Subalgebra.center ℂ (WickAlgebra 𝓕) := by - rw [ofCrAnOp, ofCrAnOp, superCommute_eq_ι_superCommuteF] - exact ι_superCommuteF_ofCrAnOpF_ofCrAnOpF_mem_center φ φ' + [ofCrAnOp φ, ofCrAnOp φ']ₛ ∈ Subalgebra.center ℂ (WickAlgebra 𝓕) := + ι_superCommuteF_ofCrAnOpF_ofCrAnOpF_mem_center φ φ' lemma superCommute_ofCrAnOp_ofCrAnOp_commute (φ φ' : 𝓕.CrAnFieldOp) (a : WickAlgebra 𝓕) : - a * [ofCrAnOp φ, ofCrAnOp φ']ₛ = [ofCrAnOp φ, ofCrAnOp φ']ₛ * a := by - have h1 := superCommute_ofCrAnOp_ofCrAnOp_mem_center φ φ' - rw [@Subalgebra.mem_center_iff] at h1 - exact h1 a + a * [ofCrAnOp φ, ofCrAnOp φ']ₛ = [ofCrAnOp φ, ofCrAnOp φ']ₛ * a := + Subalgebra.mem_center_iff.mp (superCommute_ofCrAnOp_ofCrAnOp_mem_center φ φ') a lemma superCommute_ofCrAnOp_ofFieldOp_mem_center (φ : 𝓕.CrAnFieldOp) (φ' : 𝓕.FieldOp) : [ofCrAnOp φ, ofFieldOp φ']ₛ ∈ Subalgebra.center ℂ (WickAlgebra 𝓕) := by - rw [ofFieldOp_eq_sum] - simp only [map_sum] - refine Subalgebra.sum_mem (Subalgebra.center ℂ 𝓕.WickAlgebra) ?_ - intro x hx - exact superCommute_ofCrAnOp_ofCrAnOp_mem_center φ ⟨φ', x⟩ + rw [ofFieldOp_eq_sum, map_sum] + exact Subalgebra.sum_mem _ fun x _ => superCommute_ofCrAnOp_ofCrAnOp_mem_center φ ⟨φ', x⟩ lemma superCommute_ofCrAnOp_ofFieldOp_commute (φ : 𝓕.CrAnFieldOp) (φ' : 𝓕.FieldOp) (a : WickAlgebra 𝓕) : a * [ofCrAnOp φ, ofFieldOp φ']ₛ = - [ofCrAnOp φ, ofFieldOp φ']ₛ * a := by - have h1 := superCommute_ofCrAnOp_ofFieldOp_mem_center φ φ' - rw [@Subalgebra.mem_center_iff] at h1 - exact h1 a + [ofCrAnOp φ, ofFieldOp φ']ₛ * a := + Subalgebra.mem_center_iff.mp (superCommute_ofCrAnOp_ofFieldOp_mem_center φ φ') a lemma superCommute_anPart_ofFieldOp_mem_center (φ φ' : 𝓕.FieldOp) : [anPart φ, ofFieldOp φ']ₛ ∈ Subalgebra.center ℂ (WickAlgebra 𝓕) := by - match φ with - | FieldOp.inAsymp _ => - simp only [anPart_inAsymp, map_zero, LinearMap.zero_apply] - exact Subalgebra.zero_mem (Subalgebra.center ℂ _) - | FieldOp.position φ => - exact superCommute_ofCrAnOp_ofFieldOp_mem_center _ _ - | FieldOp.outAsymp _ => - exact superCommute_ofCrAnOp_ofFieldOp_mem_center _ _ + cases φ + · simp + all_goals exact superCommute_ofCrAnOp_ofFieldOp_mem_center _ _ /-! @@ -225,128 +191,74 @@ lemma superCommute_anPart_ofFieldOp_mem_center (φ φ' : 𝓕.FieldOp) : lemma superCommute_ofCrAnList_ofCrAnList (φs φs' : List 𝓕.CrAnFieldOp) : [ofCrAnList φs, ofCrAnList φs']ₛ = - ofCrAnList (φs ++ φs') - 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofCrAnList (φs' ++ φs) := by - rw [ofCrAnList_eq_ι_ofCrAnListF, ofCrAnList_eq_ι_ofCrAnListF] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_ofCrAnListF_ofCrAnListF] - rfl + ofCrAnList (φs ++ φs') - 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofCrAnList (φs' ++ φs) := + congrArg ι (superCommuteF_ofCrAnListF_ofCrAnListF φs φs') lemma superCommute_ofCrAnOp_ofCrAnOp (φ φ' : 𝓕.CrAnFieldOp) : [ofCrAnOp φ, ofCrAnOp φ']ₛ = ofCrAnOp φ * ofCrAnOp φ' - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofCrAnOp φ' * ofCrAnOp φ := by - rw [ofCrAnOp, ofCrAnOp] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_ofCrAnOpF_ofCrAnOpF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofCrAnOp φ' * ofCrAnOp φ := + congrArg ι (superCommuteF_ofCrAnOpF_ofCrAnOpF φ φ') lemma superCommute_ofCrAnList_ofFieldOpList (φcas : List 𝓕.CrAnFieldOp) (φs : List 𝓕.FieldOp) : [ofCrAnList φcas, ofFieldOpList φs]ₛ = ofCrAnList φcas * ofFieldOpList φs - - 𝓢(𝓕 |>ₛ φcas, 𝓕 |>ₛ φs) • ofFieldOpList φs * ofCrAnList φcas := by - rw [ofCrAnList, ofFieldOpList] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_ofCrAnListF_ofFieldOpFsList] - rfl + 𝓢(𝓕 |>ₛ φcas, 𝓕 |>ₛ φs) • ofFieldOpList φs * ofCrAnList φcas := + congrArg ι (superCommuteF_ofCrAnListF_ofFieldOpFsList φcas φs) lemma superCommute_ofFieldOpList_ofFieldOpList (φs φs' : List 𝓕.FieldOp) : [ofFieldOpList φs, ofFieldOpList φs']ₛ = ofFieldOpList φs * ofFieldOpList φs' - - 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofFieldOpList φs' * ofFieldOpList φs := by - rw [ofFieldOpList, ofFieldOpList] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_ofFieldOpListF_ofFieldOpFsList] - rfl + 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofFieldOpList φs' * ofFieldOpList φs := + congrArg ι (superCommuteF_ofFieldOpListF_ofFieldOpFsList φs φs') lemma superCommute_ofFieldOp_ofFieldOpList (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : [ofFieldOp φ, ofFieldOpList φs]ₛ = ofFieldOp φ * ofFieldOpList φs - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpList φs * ofFieldOp φ := by - rw [ofFieldOp, ofFieldOpList] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_ofFieldOpF_ofFieldOpFsList] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpList φs * ofFieldOp φ := + congrArg ι (superCommuteF_ofFieldOpF_ofFieldOpFsList φ φs) lemma superCommute_ofFieldOpList_ofFieldOp (φs : List 𝓕.FieldOp) (φ : 𝓕.FieldOp) : [ofFieldOpList φs, ofFieldOp φ]ₛ = ofFieldOpList φs * ofFieldOp φ - - 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φ) • ofFieldOp φ * ofFieldOpList φs := by - rw [ofFieldOpList, ofFieldOp] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_ofFieldOpListF_ofFieldOpF] - rfl + 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φ) • ofFieldOp φ * ofFieldOpList φs := + congrArg ι (superCommuteF_ofFieldOpListF_ofFieldOpF φs φ) lemma superCommute_anPart_crPart (φ φ' : 𝓕.FieldOp) : [anPart φ, crPart φ']ₛ = anPart φ * crPart φ' - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPart φ' * anPart φ := by - rw [anPart, crPart] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_anPartF_crPartF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPart φ' * anPart φ := + congrArg ι (superCommuteF_anPartF_crPartF φ φ') lemma superCommute_crPart_anPart (φ φ' : 𝓕.FieldOp) : [crPart φ, anPart φ']ₛ = crPart φ * anPart φ' - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPart φ' * crPart φ := by - rw [anPart, crPart] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_crPartF_anPartF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPart φ' * crPart φ := + congrArg ι (superCommuteF_crPartF_anPartF φ φ') @[simp] lemma superCommute_crPart_crPart (φ φ' : 𝓕.FieldOp) : [crPart φ, crPart φ']ₛ = 0 := by - match φ, φ' with - | FieldOp.outAsymp φ, _ => - simp - | _, FieldOp.outAsymp φ => - simp - | FieldOp.position φ, FieldOp.position φ' => - simp only [crPart_position] - apply superCommute_create_create <;> rfl - | FieldOp.position φ, FieldOp.inAsymp φ' => - simp only [crPart_position, crPart_inAsymp] - apply superCommute_create_create <;> rfl - | FieldOp.inAsymp φ, FieldOp.inAsymp φ' => - simp only [crPart_inAsymp] - apply superCommute_create_create <;> rfl - | FieldOp.inAsymp φ, FieldOp.position φ' => - simp only [crPart_inAsymp, crPart_position] - apply superCommute_create_create <;> rfl + cases φ <;> cases φ' <;> + simp [superCommute_create_create, crAnFieldOpToCreateAnnihilate] @[simp] lemma superCommute_anPart_anPart (φ φ' : 𝓕.FieldOp) : [anPart φ, anPart φ']ₛ = 0 := by - match φ, φ' with - | FieldOp.inAsymp φ, _ => - simp - | _, FieldOp.inAsymp φ => - simp - | FieldOp.position φ, FieldOp.position φ' => - simp only [anPart_position] - apply superCommute_annihilate_annihilate <;> rfl - | FieldOp.position φ, FieldOp.outAsymp φ' => - simp only [anPart_position, anPart_outAsymp] - apply superCommute_annihilate_annihilate <;> rfl - | FieldOp.outAsymp φ, FieldOp.outAsymp φ' => - simp only [anPart_outAsymp] - apply superCommute_annihilate_annihilate <;> rfl - | FieldOp.outAsymp φ, FieldOp.position φ' => - simp only [anPart_outAsymp, anPart_position] - apply superCommute_annihilate_annihilate <;> rfl + cases φ <;> cases φ' <;> + simp [superCommute_annihilate_annihilate, crAnFieldOpToCreateAnnihilate] lemma superCommute_crPart_ofFieldOpList (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : [crPart φ, ofFieldOpList φs]ₛ = crPart φ * ofFieldOpList φs - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpList φs * crPart φ := by - rw [crPart, ofFieldOpList] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_crPartF_ofFieldOpListF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpList φs * crPart φ := + congrArg ι (superCommuteF_crPartF_ofFieldOpListF φ φs) lemma superCommute_anPart_ofFieldOpList (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : [anPart φ, ofFieldOpList φs]ₛ = anPart φ * ofFieldOpList φs - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpList φs * anPart φ := by - rw [anPart, ofFieldOpList] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_anPartF_ofFieldOpListF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpList φs * anPart φ := + congrArg ι (superCommuteF_anPartF_ofFieldOpListF φ φs) lemma superCommute_crPart_ofFieldOp (φ φ' : 𝓕.FieldOp) : [crPart φ, ofFieldOp φ']ₛ = crPart φ * ofFieldOp φ' - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofFieldOp φ' * crPart φ := by - rw [crPart, ofFieldOp] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_crPartF_ofFieldOpF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofFieldOp φ' * crPart φ := + congrArg ι (superCommuteF_crPartF_ofFieldOpF φ φ') lemma superCommute_anPart_ofFieldOp (φ φ' : 𝓕.FieldOp) : [anPart φ, ofFieldOp φ']ₛ = anPart φ * ofFieldOp φ' - - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofFieldOp φ' * anPart φ := by - rw [anPart, ofFieldOp] - rw [superCommute_eq_ι_superCommuteF, superCommuteF_anPartF_ofFieldOpF] - rfl + 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofFieldOp φ' * anPart φ := + congrArg ι (superCommuteF_anPartF_ofFieldOpF φ φ') /-! @@ -361,8 +273,7 @@ lemma ofCrAnList_mul_ofCrAnList_eq_superCommute (φs φs' : List 𝓕.CrAnFieldO ofCrAnList φs * ofCrAnList φs' = 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofCrAnList φs' * ofCrAnList φs + [ofCrAnList φs, ofCrAnList φs']ₛ := by - rw [superCommute_ofCrAnList_ofCrAnList] - simp [ofCrAnList_append] + simp [superCommute_ofCrAnList_ofCrAnList, ofCrAnList_append] lemma ofCrAnOp_mul_ofCrAnList_eq_superCommute (φ : 𝓕.CrAnFieldOp) (φs' : List 𝓕.CrAnFieldOp) : ofCrAnOp φ * ofCrAnList φs' = @@ -375,60 +286,49 @@ lemma ofFieldOpList_mul_ofFieldOpList_eq_superCommute (φs φs' : List 𝓕.Fiel ofFieldOpList φs * ofFieldOpList φs' = 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofFieldOpList φs' * ofFieldOpList φs + [ofFieldOpList φs, ofFieldOpList φs']ₛ := by - rw [superCommute_ofFieldOpList_ofFieldOpList] - simp + simp [superCommute_ofFieldOpList_ofFieldOpList] lemma ofFieldOp_mul_ofFieldOpList_eq_superCommute (φ : 𝓕.FieldOp) (φs' : List 𝓕.FieldOp) : ofFieldOp φ * ofFieldOpList φs' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs') • ofFieldOpList φs' * ofFieldOp φ + [ofFieldOp φ, ofFieldOpList φs']ₛ := by - rw [superCommute_ofFieldOp_ofFieldOpList] - simp + simp [superCommute_ofFieldOp_ofFieldOpList] lemma ofFieldOp_mul_ofFieldOp_eq_superCommute (φ φ' : 𝓕.FieldOp) : ofFieldOp φ * ofFieldOp φ' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • ofFieldOp φ' * ofFieldOp φ + [ofFieldOp φ, ofFieldOp φ']ₛ := by - rw [← ofFieldOpList_singleton, ← ofFieldOpList_singleton] - rw [ofFieldOpList_mul_ofFieldOpList_eq_superCommute, ofFieldOpList_singleton] + rw [← ofFieldOpList_singleton φ', ofFieldOp_mul_ofFieldOpList_eq_superCommute] simp lemma ofFieldOpList_mul_ofFieldOp_eq_superCommute (φs : List 𝓕.FieldOp) (φ : 𝓕.FieldOp) : ofFieldOpList φs * ofFieldOp φ = 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φ) • ofFieldOp φ * ofFieldOpList φs + [ofFieldOpList φs, ofFieldOp φ]ₛ := by - rw [superCommute_ofFieldOpList_ofFieldOp] - simp + simp [superCommute_ofFieldOpList_ofFieldOp] lemma ofCrAnList_mul_ofFieldOpList_eq_superCommute (φs : List 𝓕.CrAnFieldOp) (φs' : List 𝓕.FieldOp) : ofCrAnList φs * ofFieldOpList φs' = 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs') • ofFieldOpList φs' * ofCrAnList φs + [ofCrAnList φs, ofFieldOpList φs']ₛ := by - rw [superCommute_ofCrAnList_ofFieldOpList] - simp + simp [superCommute_ofCrAnList_ofFieldOpList] lemma crPart_mul_anPart_eq_superCommute (φ φ' : 𝓕.FieldOp) : crPart φ * anPart φ' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPart φ' * crPart φ + [crPart φ, anPart φ']ₛ := by - rw [superCommute_crPart_anPart] - simp + simp [superCommute_crPart_anPart] lemma anPart_mul_crPart_eq_superCommute (φ φ' : 𝓕.FieldOp) : anPart φ * crPart φ' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPart φ' * anPart φ + [anPart φ, crPart φ']ₛ := by - rw [superCommute_anPart_crPart] - simp + simp [superCommute_anPart_crPart] lemma crPart_mul_crPart_swap (φ φ' : 𝓕.FieldOp) : crPart φ * crPart φ' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPart φ' * crPart φ := by - trans 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPart φ' * crPart φ + [crPart φ, crPart φ']ₛ - · rw [crPart, crPart, superCommute_eq_ι_superCommuteF, superCommuteF_crPartF_crPartF] - simp - · simp + rw [← sub_eq_zero, ← superCommute_crPart_crPart φ φ'] + exact (congrArg ι (superCommuteF_crPartF_crPartF φ φ')).symm lemma anPart_mul_anPart_swap (φ φ' : 𝓕.FieldOp) : anPart φ * anPart φ' = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPart φ' * anPart φ := by - trans 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPart φ' * anPart φ + [anPart φ, anPart φ']ₛ - · rw [anPart, anPart, superCommute_eq_ι_superCommuteF, superCommuteF_anPartF_anPartF] - simp - · simp + rw [← sub_eq_zero, ← superCommute_anPart_anPart φ φ'] + exact (congrArg ι (superCommuteF_anPartF_anPartF φ φ')).symm /-! @@ -438,17 +338,13 @@ lemma anPart_mul_anPart_swap (φ φ' : 𝓕.FieldOp) : lemma superCommute_ofCrAnList_ofCrAnList_symm (φs φs' : List 𝓕.CrAnFieldOp) : [ofCrAnList φs, ofCrAnList φs']ₛ = - (- 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs')) • [ofCrAnList φs', ofCrAnList φs]ₛ := by - rw [ofCrAnList, ofCrAnList, superCommute_eq_ι_superCommuteF, - superCommuteF_ofCrAnListF_ofCrAnListF_symm] - rfl + (- 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs')) • [ofCrAnList φs', ofCrAnList φs]ₛ := + congrArg ι (superCommuteF_ofCrAnListF_ofCrAnListF_symm φs φs') lemma superCommute_ofCrAnOp_ofCrAnOp_symm (φ φ' : 𝓕.CrAnFieldOp) : [ofCrAnOp φ, ofCrAnOp φ']ₛ = - (- 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ')) • [ofCrAnOp φ', ofCrAnOp φ]ₛ := by - rw [ofCrAnOp, ofCrAnOp, superCommute_eq_ι_superCommuteF, - superCommuteF_ofCrAnOpF_ofCrAnOpF_symm] - rfl + (- 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ')) • [ofCrAnOp φ', ofCrAnOp φ]ₛ := + congrArg ι (superCommuteF_ofCrAnOpF_ofCrAnOpF_symm φ φ') /-! @@ -461,52 +357,36 @@ lemma superCommute_ofCrAnList_ofCrAnList_eq_sum (φs φs' : List 𝓕.CrAnFieldO ∑ (n : Fin φs'.length), 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs'.take n) • ofCrAnList (φs'.take n) * [ofCrAnList φs, ofCrAnOp (φs'.get n)]ₛ * ofCrAnList (φs'.drop (n + 1)) := by - conv_lhs => - rw [ofCrAnList, ofCrAnList, superCommute_eq_ι_superCommuteF, - superCommuteF_ofCrAnListF_ofCrAnListF_eq_sum] - rw [map_sum] + rw [ofCrAnList, ofCrAnList, superCommute_eq_ι_superCommuteF, + superCommuteF_ofCrAnListF_ofCrAnListF_eq_sum, map_sum] rfl lemma superCommute_ofCrAnOp_ofCrAnList_eq_sum (φ : 𝓕.CrAnFieldOp) (φs' : List 𝓕.CrAnFieldOp) : [ofCrAnOp φ, ofCrAnList φs']ₛ = ∑ (n : Fin φs'.length), 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs'.take n) • [ofCrAnOp φ, ofCrAnOp (φs'.get n)]ₛ * ofCrAnList (φs'.eraseIdx n) := by - conv_lhs => - rw [← ofCrAnList_singleton, superCommute_ofCrAnList_ofCrAnList_eq_sum] - congr - funext n - simp only [ofList_singleton, List.get_eq_getElem, Algebra.smul_mul_assoc] - congr 1 + conv_lhs => rw [← ofCrAnList_singleton, superCommute_ofCrAnList_ofCrAnList_eq_sum] + refine Finset.sum_congr rfl fun n _ => ?_ rw [ofCrAnList_singleton, superCommute_ofCrAnOp_ofCrAnOp_commute] - rw [mul_assoc, ← ofCrAnList_append] - congr - exact Eq.symm (List.eraseIdx_eq_take_drop_succ φs' ↑n) + simp [mul_assoc, ← ofCrAnList_append, ← List.eraseIdx_eq_take_drop_succ, ofList_singleton] lemma superCommute_ofCrAnList_ofFieldOpList_eq_sum (φs : List 𝓕.CrAnFieldOp) (φs' : List 𝓕.FieldOp) : [ofCrAnList φs, ofFieldOpList φs']ₛ = ∑ (n : Fin φs'.length), 𝓢(𝓕 |>ₛ φs, 𝓕 |>ₛ φs'.take n) • ofFieldOpList (φs'.take n) * [ofCrAnList φs, ofFieldOp (φs'.get n)]ₛ * ofFieldOpList (φs'.drop (n + 1)) := by - conv_lhs => - rw [ofCrAnList, ofFieldOpList, superCommute_eq_ι_superCommuteF, - superCommuteF_ofCrAnListF_ofFieldOpListF_eq_sum] - rw [map_sum] + rw [ofCrAnList, ofFieldOpList, superCommute_eq_ι_superCommuteF, + superCommuteF_ofCrAnListF_ofFieldOpListF_eq_sum, map_sum] rfl lemma superCommute_ofCrAnOp_ofFieldOpList_eq_sum (φ : 𝓕.CrAnFieldOp) (φs' : List 𝓕.FieldOp) : [ofCrAnOp φ, ofFieldOpList φs']ₛ = ∑ (n : Fin φs'.length), 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs'.take n) • [ofCrAnOp φ, ofFieldOp (φs'.get n)]ₛ * ofFieldOpList (φs'.eraseIdx n) := by - conv_lhs => - rw [← ofCrAnList_singleton, superCommute_ofCrAnList_ofFieldOpList_eq_sum] - congr - funext n - simp only [ofList_singleton, List.get_eq_getElem, Algebra.smul_mul_assoc] - congr 1 + conv_lhs => rw [← ofCrAnList_singleton, superCommute_ofCrAnList_ofFieldOpList_eq_sum] + refine Finset.sum_congr rfl fun n _ => ?_ rw [ofCrAnList_singleton, superCommute_ofCrAnOp_ofFieldOp_commute] - rw [mul_assoc, ← ofFieldOpList_append] - congr - exact Eq.symm (List.eraseIdx_eq_take_drop_succ φs' ↑n) + simp [mul_assoc, ← ofFieldOpList_append, ← List.eraseIdx_eq_take_drop_succ, ofList_singleton] end WickAlgebra end FieldSpecification diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean index 06137c996..31e3484e8 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean @@ -71,21 +71,12 @@ lemma ι_timeOrderF_superCommuteF_superCommuteF_eq_time_ofCrAnListF {φ1 φ2 φ3 simp only [decide_not, Bool.decide_and, ofCrAnListF_append, map_smul, map_mul, l1, l2, mul_assoc] congr 1 - have hp : List.Perm [φ1, φ3, φ2] [φ1, φ2, φ3] := by - refine List.Perm.cons φ1 ?_ - exact List.Perm.swap φ2 φ3 [] + have hp : List.Perm [φ1, φ3, φ2] [φ1, φ2, φ3] := .cons φ1 (.swap φ2 φ3 []) rw [crAnTimeOrderSign, Wick.koszulSign_perm_eq _ _ φ1 _ _ _ _ _ hp, ← crAnTimeOrderSign] · simp - · intro φ4 hφ4 - simp only [List.mem_cons, List.not_mem_nil, or_false] at hφ4 - rcases hφ4 with hφ4 | hφ4 | hφ4 - all_goals - subst hφ4 - simp_all - have hp231 : List.Perm [φ2, φ3, φ1] [φ1, φ2, φ3] := by - refine List.Perm.trans (l₂ := [φ2, φ1, φ3]) ?_ ?_ - refine List.Perm.cons φ2 (List.Perm.swap φ1 φ3 []) - exact List.Perm.swap φ1 φ2 [φ3] + · simp_all + have hp231 : List.Perm [φ2, φ3, φ1] [φ1, φ2, φ3] := + ((List.Perm.swap φ1 φ3 []).cons φ2).trans (List.Perm.swap φ1 φ2 [φ3]) have h231 : ι 𝓣ᶠ(ofCrAnListF (φs1 ++ φ2 :: φ3 :: φ1 :: φs2)) = crAnTimeOrderSign (φs1 ++ φ1 :: φ2 :: φ3 :: φs2) • (ι (ofCrAnListF l1) * ι (ofCrAnListF [φ2, φ3, φ1]) * ι (ofCrAnListF l2)) := by @@ -98,12 +89,7 @@ lemma ι_timeOrderF_superCommuteF_superCommuteF_eq_time_ofCrAnListF {φ1 φ2 φ3 congr 1 rw [crAnTimeOrderSign, Wick.koszulSign_perm_eq _ _ φ1 _ _ _ _ _ hp231, ← crAnTimeOrderSign] · simp - · intro φ4 hφ4 - simp only [List.mem_cons, List.not_mem_nil, or_false] at hφ4 - rcases hφ4 with hφ4 | hφ4 | hφ4 - all_goals - subst hφ4 - simp_all + · simp_all have h321 : ι 𝓣ᶠ(ofCrAnListF (φs1 ++ φ3 :: φ2 :: φ1 :: φs2)) = crAnTimeOrderSign (φs1 ++ φ1 :: φ2 :: φ3 :: φs2) • (ι (ofCrAnListF l1) * ι (ofCrAnListF [φ3, φ2, φ1]) * ι (ofCrAnListF l2)) := by @@ -114,25 +100,17 @@ lemma ι_timeOrderF_superCommuteF_superCommuteF_eq_time_ofCrAnListF {φ1 φ2 φ3 simp only [decide_not, Bool.decide_and, ofCrAnListF_append, map_smul, map_mul, l1, l2, mul_assoc] congr 1 - have hp : List.Perm [φ3, φ2, φ1] [φ1, φ2, φ3] := by - refine List.Perm.trans ?_ hp231 - exact List.Perm.swap φ2 φ3 [φ1] + have hp : List.Perm [φ3, φ2, φ1] [φ1, φ2, φ3] := (List.Perm.swap φ2 φ3 [φ1]).trans hp231 rw [crAnTimeOrderSign, Wick.koszulSign_perm_eq _ _ φ1 _ _ _ _ _ hp, ← crAnTimeOrderSign] · simp - · intro φ4 hφ4 - simp only [List.mem_cons, List.not_mem_nil, or_false] at hφ4 - rcases hφ4 with hφ4 | hφ4 | hφ4 - all_goals - subst hφ4 - simp_all + · simp_all rw [h123, h132, h231, h321] trans crAnTimeOrderSign (φs1 ++ φ1 :: φ2 :: φ3 :: φs2) • (ι (ofCrAnListF l1) * ι [ofCrAnOpF φ1, [ofCrAnOpF φ2, ofCrAnOpF φ3]ₛF]ₛF * ι (ofCrAnListF l2)); swap · simp - rw [mul_assoc] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, ← ofCrAnListF_singleton] - rw [superCommuteF_ofCrAnListF_ofCrAnListF] + rw [mul_assoc, ← ofCrAnListF_singleton, ← ofCrAnListF_singleton, ← ofCrAnListF_singleton, + superCommuteF_ofCrAnListF_ofCrAnListF] simp only [List.singleton_append, ofList_singleton, map_sub, map_smul] rw [superCommuteF_ofCrAnListF_ofCrAnListF, superCommuteF_ofCrAnListF_ofCrAnListF] simp [List.cons_append, List.nil_append, ofList_singleton, map_sub, @@ -149,8 +127,7 @@ lemma ι_timeOrderF_superCommuteF_superCommuteF_ofCrAnListF {φ1 φ2 φ3 : 𝓕. crAnTimeOrderRel φ3 φ1 ∧ crAnTimeOrderRel φ3 φ2 · exact ι_timeOrderF_superCommuteF_superCommuteF_eq_time_ofCrAnListF φs1 φs2 h · rw [timeOrderF_timeOrderF_mid] - rw [timeOrderF_superCommuteF_ofCrAnOpF_superCommuteF_all_not_crAnTimeOrderRel _ _ _ h] - simp + simp [timeOrderF_superCommuteF_ofCrAnOpF_superCommuteF_all_not_crAnTimeOrderRel _ _ _ h] @[simp] lemma ι_timeOrderF_superCommuteF_superCommuteF {φ1 φ2 φ3 : 𝓕.CrAnFieldOp} @@ -160,17 +137,15 @@ lemma ι_timeOrderF_superCommuteF_superCommuteF {φ1 φ2 φ3 : 𝓕.CrAnFieldOp} Prop := ι 𝓣ᶠ(a * [ofCrAnOpF φ1, [ofCrAnOpF φ2, ofCrAnOpF φ3]ₛF]ₛF * b) = 0 change pb b (Basis.mem_span _ b) apply Submodule.span_induction - · intro x hx - obtain ⟨φs, rfl⟩ := hx + · rintro x ⟨φs, rfl⟩ simp only [ofListBasis_eq_ofList, pb] let pa (a : 𝓕.FieldOpFreeAlgebra) (hc : a ∈ Submodule.span ℂ (Set.range ofCrAnListFBasis)) : Prop := ι 𝓣ᶠ(a * [ofCrAnOpF φ1, [ofCrAnOpF φ2, ofCrAnOpF φ3]ₛF]ₛF * ofCrAnListF φs) = 0 change pa a (Basis.mem_span _ a) apply Submodule.span_induction - · intro x hx - obtain ⟨φs', rfl⟩ := hx - simp only [ofListBasis_eq_ofList, pa] - exact ι_timeOrderF_superCommuteF_superCommuteF_ofCrAnListF φs' φs + · rintro x ⟨φs', rfl⟩ + simpa only [ofListBasis_eq_ofList, pa] using + ι_timeOrderF_superCommuteF_superCommuteF_ofCrAnListF φs' φs · simp [pa] · intro x y hx hy hpx hpy simp_all [pa, add_mul] @@ -183,7 +158,7 @@ lemma ι_timeOrderF_superCommuteF_superCommuteF {φ1 φ2 φ3 : 𝓕.CrAnFieldOp} simp_all [pb] example (c1 c2 : ℂ) (a : 𝓕.WickAlgebra) : c1 • c2 • a = - c2 • c1 • a := by exact smul_comm c1 c2 a + c2 • c1 • a := smul_comm c1 c2 a lemma ι_timeOrderF_superCommuteF_eq_time {φ ψ : 𝓕.CrAnFieldOp} (hφψ : crAnTimeOrderRel φ ψ) (hψφ : crAnTimeOrderRel ψ φ) (a b : 𝓕.FieldOpFreeAlgebra) : ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * b) = @@ -193,16 +168,14 @@ lemma ι_timeOrderF_superCommuteF_eq_time {φ ψ : 𝓕.CrAnFieldOp} ι ([ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * 𝓣ᶠ(a * b)) change pb b (Basis.mem_span _ b) apply Submodule.span_induction - · intro x hx - obtain ⟨φs, rfl⟩ := hx + · rintro x ⟨φs, rfl⟩ simp only [ofListBasis_eq_ofList, map_mul, pb] let pa (a : 𝓕.FieldOpFreeAlgebra) (hc : a ∈ Submodule.span ℂ (Set.range ofCrAnListFBasis)) : Prop := ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * ofCrAnListF φs) = ι ([ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * 𝓣ᶠ(a* ofCrAnListF φs)) change pa a (Basis.mem_span _ a) apply Submodule.span_induction - · intro x hx - obtain ⟨φs', rfl⟩ := hx + · rintro x ⟨φs', rfl⟩ simp only [ofListBasis_eq_ofList, map_mul, pa] calc _ /- Split the commutator. -/ @@ -223,17 +196,7 @@ lemma ι_timeOrderF_superCommuteF_eq_time {φ ψ : 𝓕.CrAnFieldOp} (ι (ofCrAnListF (crAnTimeOrderList (φs' ++ φ :: ψ :: φs))) - 𝓢(𝓕.crAnStatistics φ, 𝓕.crAnStatistics ψ) • ι (ofCrAnListF (crAnTimeOrderList (φs' ++ ψ :: φ :: φs)))) := by - have h1 : crAnTimeOrderSign (φs' ++ φ :: ψ :: φs) = - crAnTimeOrderSign (φs' ++ ψ :: φ :: φs) := by - trans crAnTimeOrderSign (φs' ++ [φ, ψ] ++ φs) - simp only [List.append_assoc, List.cons_append, List.nil_append] - rw [crAnTimeOrderSign] - have hp : List.Perm [φ,ψ] [ψ,φ] := by exact List.Perm.swap ψ φ [] - rw [Wick.koszulSign_perm_eq _ _ φ _ _ _ _ _ hp] - simp only [List.append_assoc, List.cons_append] - rfl - simp_all - rw [h1] + rw [crAnTimeOrderSign_swap_eq_time hφψ hψφ] module /- Splitting the time-ordered lists. -/ _ = crAnTimeOrderSign (φs' ++ [φ, ψ] ++ φs) • @@ -288,34 +251,21 @@ lemma ι_timeOrderF_superCommuteF_eq_time {φ ψ : 𝓕.CrAnFieldOp} ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧ ¬crAnTimeOrderRel c φ)) (List.insertionSort crAnTimeOrderRel (φs' ++ φs))))) := by congr - rw [superCommuteF_ofCrAnOpF_ofCrAnOpF] - rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton, ← ofCrAnListF_append] - simp only [List.singleton_append, Algebra.smul_mul_assoc, map_sub, - map_smul] - rw [← ofCrAnListF_append] - simp - have hc : ι ((superCommuteF (ofCrAnOpF φ)) (ofCrAnOpF ψ)) ∈ - Subalgebra.center ℂ 𝓕.WickAlgebra := by - apply ι_superCommuteF_ofCrAnOpF_ofCrAnOpF_mem_center - rw [Subalgebra.mem_center_iff] at hc - rw [hc] + rw [superCommuteF_ofCrAnOpF_ofCrAnOpF, ← ofCrAnListF_singleton, + ← ofCrAnListF_singleton] + simp [← ofCrAnListF_append] + rw [Subalgebra.mem_center_iff.mp (ι_superCommuteF_ofCrAnOpF_ofCrAnOpF_mem_center φ ψ)] repeat rw [mul_assoc] - rw [← map_mul, ← map_mul, ← map_mul] - rw [← ofCrAnListF_append, ← ofCrAnListF_append, ← ofCrAnListF_append] + rw [← map_mul, ← map_mul, ← map_mul, ← ofCrAnListF_append, ← ofCrAnListF_append, + ← ofCrAnListF_append] have h1 := insertionSort_of_takeWhile_filter 𝓕.crAnTimeOrderRel φ φs' φs simp [decide_not, Bool.decide_and, List.append_assoc, List.cons_append] at h1 ⊢ - rw [← h1] - rw [← crAnTimeOrderList] + rw [← h1, ← crAnTimeOrderList] by_cases hq : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ) - · rw [ι_superCommuteF_of_diff_statistic hq] - simp - · rw [crAnTimeOrderSign, Wick.koszulSign_eq_rel_eq_stat _ _, ← crAnTimeOrderSign] - rw [← ofCrAnListF_append] - rw [timeOrderF_ofCrAnListF] + · simp [ι_superCommuteF_of_diff_statistic hq] + · rw [crAnTimeOrderSign, Wick.koszulSign_eq_rel_eq_stat _ _ hφψ hψφ (by simp_all), + ← crAnTimeOrderSign, ← ofCrAnListF_append, timeOrderF_ofCrAnListF] simp only [map_smul, Algebra.mul_smul_comm] - exact hφψ - exact hψφ - simp_all · simp only [map_mul, zero_mul, map_zero, mul_zero, pa] · intro x y hx hy hpx hpy simp_all [pa,mul_add, add_mul] @@ -331,18 +281,10 @@ lemma ι_timeOrderF_superCommuteF_ne_time {φ ψ : 𝓕.CrAnFieldOp} (hφψ : ¬ (crAnTimeOrderRel φ ψ ∧ crAnTimeOrderRel ψ φ)) (a b : 𝓕.FieldOpFreeAlgebra) : ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * b) = 0 := by rw [timeOrderF_timeOrderF_mid] - have hφψ : ¬ (crAnTimeOrderRel φ ψ) ∨ ¬ (crAnTimeOrderRel ψ φ) := by - exact Decidable.not_and_iff_or_not.mp hφψ - rcases hφψ with hφψ | hφψ - · rw [timeOrderF_superCommuteF_ofCrAnOpF_ofCrAnOpF_not_crAnTimeOrderRel] - simp_all only [false_and, not_false_eq_true, mul_zero, zero_mul, map_zero] - simp_all + rcases Decidable.not_and_iff_or_not.mp hφψ with hφψ | hφψ + · simp [timeOrderF_superCommuteF_ofCrAnOpF_ofCrAnOpF_not_crAnTimeOrderRel hφψ] · rw [superCommuteF_ofCrAnOpF_ofCrAnOpF_symm] - simp only [neg_smul, map_neg, map_smul, mul_neg, Algebra.mul_smul_comm, - neg_mul, Algebra.smul_mul_assoc, neg_eq_zero, smul_eq_zero] - rw [timeOrderF_superCommuteF_ofCrAnOpF_ofCrAnOpF_not_crAnTimeOrderRel] - simp only [mul_zero, zero_mul, map_zero, or_true] - simp_all + simp [timeOrderF_superCommuteF_ofCrAnOpF_ofCrAnOpF_not_crAnTimeOrderRel hφψ] /-! @@ -357,63 +299,34 @@ lemma ι_timeOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) (h : a ∈ AddSubgroup.closure k) := ι 𝓣ᶠ(a) = 0 change p a h apply AddSubgroup.closure_induction - · intro x hx - obtain ⟨a, ha, b, hb, rfl⟩ := Set.mem_mul.mp hx - obtain ⟨a, ha, c, hc, rfl⟩ := ha + · rintro x ⟨_, ⟨a, ha, c, hc, rfl⟩, b, hb, rfl⟩ simp only [p] simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_setOf_eq] at hc - match hc with - | Or.inl hc => - obtain ⟨φa, φa', hφa, hφa', rfl⟩ := hc - simp only [ι_timeOrderF_superCommuteF_superCommuteF] - | Or.inr (Or.inl hc) => - obtain ⟨φa, hφa, φb, hφb, rfl⟩ := hc - by_cases heqt : (crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa) - · rw [ι_timeOrderF_superCommuteF_eq_time] - simp only [map_mul] - rw [ι_superCommuteF_of_create_create] - simp only [zero_mul] - · exact hφa - · exact hφb - · exact heqt.1 - · exact heqt.2 + rcases hc with ⟨φa, φa', hφa, hφa', rfl⟩ | ⟨φa, hφa, φb, hφb, rfl⟩ | + ⟨φa, hφa, φb, hφb, rfl⟩ | ⟨φa, φb, hdiff, rfl⟩ + · simp + · by_cases heqt : crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa + · rw [ι_timeOrderF_superCommuteF_eq_time heqt.1 heqt.2, map_mul, + ι_superCommuteF_of_create_create _ _ hφa hφb, zero_mul] · rw [ι_timeOrderF_superCommuteF_ne_time heqt] - | Or.inr (Or.inr (Or.inl hc)) => - obtain ⟨φa, hφa, φb, hφb, rfl⟩ := hc - by_cases heqt : (crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa) - · rw [ι_timeOrderF_superCommuteF_eq_time] - simp only [map_mul] - rw [ι_superCommuteF_of_annihilate_annihilate] - simp only [zero_mul] - · exact hφa - · exact hφb - · exact heqt.1 - · exact heqt.2 + · by_cases heqt : crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa + · rw [ι_timeOrderF_superCommuteF_eq_time heqt.1 heqt.2, map_mul, + ι_superCommuteF_of_annihilate_annihilate _ _ hφa hφb, zero_mul] · rw [ι_timeOrderF_superCommuteF_ne_time heqt] - | Or.inr (Or.inr (Or.inr hc)) => - obtain ⟨φa, φb, hdiff, rfl⟩ := hc - by_cases heqt : (crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa) - · rw [ι_timeOrderF_superCommuteF_eq_time] - simp only [map_mul] - rw [ι_superCommuteF_of_diff_statistic] - simp only [zero_mul] - · exact hdiff - · exact heqt.1 - · exact heqt.2 + · by_cases heqt : crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa + · rw [ι_timeOrderF_superCommuteF_eq_time heqt.1 heqt.2, map_mul, + ι_superCommuteF_of_diff_statistic hdiff, zero_mul] · rw [ι_timeOrderF_superCommuteF_ne_time heqt] · simp [p] - · intro x y hx hy - simp only [map_add, p] - intro h1 h2 - simp [h1, h2] + · intro x y hx hy h1 h2 + simp_all [p] · intro x hx simp [p] lemma ι_timeOrderF_eq_of_equiv (a b : 𝓕.FieldOpFreeAlgebra) (h : a ≈ b) : ι 𝓣ᶠ(a) = ι 𝓣ᶠ(b) := by - rw [equiv_iff_sub_mem_ideal] at h - rw [← sub_eq_zero, ← map_sub, ← LinearMap.map_sub] - exact ι_timeOrderF_zero_of_mem_ideal (a - b) h + rw [← sub_eq_zero, ← map_sub, ← map_sub] + exact ι_timeOrderF_zero_of_mem_ideal _ ((equiv_iff_sub_mem_ideal a b).mp h) /-- For a field specification `𝓕`, `timeOrder` is the linear map @@ -466,13 +379,11 @@ lemma timeOrder_ofFieldOp_ofFieldOp_not_ordered_eq_timeOrder {φ ψ : 𝓕.Field (h : ¬ timeOrderRel φ ψ) : 𝓣(ofFieldOp φ * ofFieldOp ψ) = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ψ) • 𝓣(ofFieldOp ψ * ofFieldOp φ) := by rw [ofFieldOp, ofFieldOp, ← map_mul, timeOrder_eq_ι_timeOrderF, - timeOrderF_ofFieldOpF_ofFieldOpF_not_ordered_eq_timeOrderF h] - simp only [map_smul] + timeOrderF_ofFieldOpF_ofFieldOpF_not_ordered_eq_timeOrderF h, map_smul] rfl lemma timeOrder_ofFieldOpList_nil : 𝓣(ofFieldOpList (𝓕 := 𝓕) []) = 1 := by - rw [ofFieldOpList, timeOrder_eq_ι_timeOrderF, timeOrderF_ofFieldOpListF_nil] - simp + rw [ofFieldOpList, timeOrder_eq_ι_timeOrderF, timeOrderF_ofFieldOpListF_nil, map_one] @[simp] lemma timeOrder_ofFieldOpList_singleton (φ : 𝓕.FieldOp) : @@ -497,52 +408,34 @@ lemma timeOrder_superCommute_eq_time_mid {φ ψ : 𝓕.CrAnFieldOp} (hφψ : crAnTimeOrderRel φ ψ) (hψφ : crAnTimeOrderRel ψ φ) (a b : 𝓕.WickAlgebra) : 𝓣(a * [ofCrAnOp φ, ofCrAnOp ψ]ₛ * b) = [ofCrAnOp φ, ofCrAnOp ψ]ₛ * 𝓣(a * b) := by - rw [ofCrAnOp, ofCrAnOp] - rw [superCommute_eq_ι_superCommuteF] obtain ⟨a, rfl⟩ := ι_surjective a obtain ⟨b, rfl⟩ := ι_surjective b - rw [← map_mul, ← map_mul, timeOrder_eq_ι_timeOrderF] - rw [ι_timeOrderF_superCommuteF_eq_time] + rw [ofCrAnOp, ofCrAnOp, superCommute_eq_ι_superCommuteF, ← map_mul, ← map_mul, + timeOrder_eq_ι_timeOrderF, ι_timeOrderF_superCommuteF_eq_time hφψ hψφ] rfl - · simp_all - · simp_all lemma timeOrder_superCommute_eq_time_left {φ ψ : 𝓕.CrAnFieldOp} (hφψ : crAnTimeOrderRel φ ψ) (hψφ : crAnTimeOrderRel ψ φ) (b : 𝓕.WickAlgebra) : 𝓣([ofCrAnOp φ, ofCrAnOp ψ]ₛ * b) = [ofCrAnOp φ, ofCrAnOp ψ]ₛ * 𝓣(b) := by - trans 𝓣(1 * [ofCrAnOp φ, ofCrAnOp ψ]ₛ * b) - simp only [one_mul] - rw [timeOrder_superCommute_eq_time_mid hφψ hψφ] - simp + simpa using timeOrder_superCommute_eq_time_mid hφψ hψφ 1 b lemma timeOrder_superCommute_ne_time {φ ψ : 𝓕.CrAnFieldOp} (hφψ : ¬ (crAnTimeOrderRel φ ψ ∧ crAnTimeOrderRel ψ φ)) : 𝓣([ofCrAnOp φ, ofCrAnOp ψ]ₛ) = 0 := by - rw [ofCrAnOp, ofCrAnOp] - rw [superCommute_eq_ι_superCommuteF] - rw [timeOrder_eq_ι_timeOrderF] - trans ι (timeOrderF (1 * (superCommuteF (ofCrAnOpF φ)) (ofCrAnOpF ψ) * 1)) - simp only [one_mul, mul_one] - rw [ι_timeOrderF_superCommuteF_ne_time] - exact hφψ + rw [ofCrAnOp, ofCrAnOp, superCommute_eq_ι_superCommuteF, timeOrder_eq_ι_timeOrderF] + simpa using ι_timeOrderF_superCommuteF_ne_time hφψ 1 1 lemma timeOrder_superCommute_anPart_ofFieldOp_ne_time {φ ψ : 𝓕.FieldOp} (hφψ : ¬ (timeOrderRel φ ψ ∧ timeOrderRel ψ φ)) : 𝓣([anPart φ,ofFieldOp ψ]ₛ) = 0 := by rw [ofFieldOp_eq_sum] simp only [map_sum] - apply Finset.sum_eq_zero - intro a ha + refine Finset.sum_eq_zero fun a ha => ?_ match φ with - | .inAsymp φ => - simp - | .position φ => - simp only [anPart_position] - apply timeOrder_superCommute_ne_time - simp_all [crAnTimeOrderRel] - | .outAsymp φ => - simp only [anPart_outAsymp] + | .inAsymp φ => simp + | .position φ | .outAsymp φ => + simp only [anPart_position, anPart_outAsymp] apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] @@ -558,25 +451,16 @@ lemma timeOrder_timeOrder_mid (a b c : 𝓕.WickAlgebra) : lemma timeOrder_timeOrder_left (b c : 𝓕.WickAlgebra) : 𝓣(b * c) = 𝓣(𝓣(b) * c) := by - trans 𝓣(1 * b * c) - simp only [one_mul] - rw [timeOrder_timeOrder_mid] - simp + simpa using timeOrder_timeOrder_mid 1 b c lemma timeOrder_timeOrder_right (a b : 𝓕.WickAlgebra) : 𝓣(a * b) = 𝓣(a * 𝓣(b)) := by - trans 𝓣(a * b * 1) - simp only [mul_one] - rw [timeOrder_timeOrder_mid] - simp + simpa using timeOrder_timeOrder_mid a b 1 /-- Time ordering is a projection. -/ lemma timeOrder_timeOrder (a : 𝓕.WickAlgebra) : 𝓣(𝓣(a)) = 𝓣(a) := by - trans 𝓣(𝓣(a) * 1) - · simp - · rw [← timeOrder_timeOrder_left] - simp + simpa using (timeOrder_timeOrder_left a 1).symm end WickAlgebra end FieldSpecification diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheorem.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheorem.lean index d8902b703..497879840 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheorem.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheorem.lean @@ -41,9 +41,7 @@ open FieldStatistic lemma wicks_theorem_congr {φs φs' : List 𝓕.FieldOp} (h : φs = φs') : ∑ (φsΛ : WickContraction φs.length), φsΛ.wickTerm - = ∑ (φs'Λ : WickContraction φs'.length), φs'Λ.wickTerm := by - subst h - rfl + = ∑ (φs'Λ : WickContraction φs'.length), φs'Λ.wickTerm := h ▸ rfl /-- For a list `φs` of `𝓕.FieldOp`, Wick's theorem states that @@ -81,10 +79,8 @@ lemmas used. theorem wicks_theorem : (φs : List 𝓕.FieldOp) → 𝓣(ofFieldOpList φs) = ∑ (φsΛ : WickContraction φs.length), φsΛ.wickTerm | [] => by - rw [timeOrder_ofFieldOpList_nil] - simp only [List.length_nil] - rw [sum_WickContraction_nil] - simp only [wickTerm_empty_nil] + simp only [timeOrder_ofFieldOpList_nil, List.length_nil, sum_WickContraction_nil, + wickTerm_empty_nil] | φ :: φs => by have ih := wicks_theorem (eraseMaxTimeField φ φs) conv_lhs => rw [timeOrder_eq_maxTimeField_mul_finset, ih, Finset.mul_sum] @@ -93,17 +89,10 @@ theorem wicks_theorem : (φs : List 𝓕.FieldOp) → 𝓣(ofFieldOpList φs) = simp only [eraseMaxTimeField, insertionSortDropMinPos, List.length_cons, Nat.succ_eq_add_one, maxTimeField, insertionSortMin, List.get_eq_getElem] erw [insertIdx_eraseIdx_fin] - conv_rhs => rw [wicks_theorem_congr h1] - conv_rhs => rw [insertLift_sum] - apply Finset.sum_congr rfl - intro c _ + conv_rhs => rw [wicks_theorem_congr h1, insertLift_sum] + refine Finset.sum_congr rfl fun c _ => ?_ rw [Algebra.smul_mul_assoc, mul_wickTerm_eq_sum - (maxTimeField φ φs) (eraseMaxTimeField φ φs) (maxTimeFieldPosFin φ φs) c] - trans (1 : ℂ) • ∑ k : Option { x // x ∈ c.uncontracted }, - (c ↩Λ (maxTimeField φ φs) (maxTimeFieldPosFin φ φs) k).wickTerm - swap - · simp - rw [smul_smul] + (maxTimeField φ φs) (eraseMaxTimeField φ φs) (maxTimeFieldPosFin φ φs) c, smul_smul] simp only [exchangeSign_mul_self, Nat.succ_eq_add_one, Fintype.sum_option, Finset.univ_eq_attach, smul_add, one_smul] · exact fun k => timeOrder_maxTimeField _ _ k diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean index 3ffe501b8..f429c4ca2 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean @@ -57,15 +57,13 @@ lemma timeOrder_ofFieldOpList_eqTimeOnly (φs : List 𝓕.FieldOp) : simp only [staticWickTerm, Algebra.smul_mul_assoc, map_smul] conv_lhs => enter [2, 2, x] - rw [timeOrder_timeOrder_left] - rw [timeOrder_staticContract_of_not_mem _ x.2] + rw [timeOrder_timeOrder_left, timeOrder_staticContract_of_not_mem _ x.2] simp only [zero_mul, map_zero, smul_zero, Finset.sum_const_zero, add_zero] congr funext x - rw [staticContract_eq_timeContract_of_eqTimeOnly] - rw [timeOrder_timeContract_mul_of_eqTimeOnly_left] - exact x.2 - exact x.2 + rw [staticContract_eq_timeContract_of_eqTimeOnly, + timeOrder_timeContract_mul_of_eqTimeOnly_left] <;> + exact x.2 lemma timeOrder_ofFieldOpList_eq_eqTimeOnly_empty (φs : List 𝓕.FieldOp) : 𝓣(ofFieldOpList φs) = 𝓣(𝓝(ofFieldOpList φs)) + @@ -87,11 +85,8 @@ lemma timeOrder_ofFieldOpList_eq_eqTimeOnly_empty (φs : List 𝓕.FieldOp) : simp [a.2], right_inv a := by simp} rw [← e2.symm.sum_comp] simp [e2, sign_empty] - · let e2 : { φsΛ : {φsΛ : WickContraction φs.length // φsΛ.EqTimeOnly} // ¬ φsΛ.1 = empty } ≃ - {φsΛ // φsΛ.EqTimeOnly ∧ φsΛ ≠ empty} := { - toFun := fun x => ⟨x, ⟨x.1.2, x.2⟩⟩, invFun := fun x => ⟨⟨x.1, x.2.1⟩, x.2.2⟩, - left_inv a := by rfl, right_inv a := by rfl } - rw [← e2.symm.sum_comp] + · rw [← (Equiv.subtypeSubtypeEquivSubtypeInter + (fun φsΛ : WickContraction φs.length => φsΛ.EqTimeOnly) (· ≠ empty)).symm.sum_comp] rfl /-- @@ -109,8 +104,7 @@ lemma normalOrder_timeOrder_ofFieldOpList_eq_eqTimeOnly_empty (φs : List 𝓕.F 𝓣(𝓝(ofFieldOpList φs)) = 𝓣(ofFieldOpList φs) - ∑ (φsΛ : {φsΛ // φsΛ.EqTimeOnly (φs := φs) ∧ φsΛ ≠ empty}), φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)) := by - rw [timeOrder_ofFieldOpList_eq_eqTimeOnly_empty] - simp + simp [timeOrder_ofFieldOpList_eq_eqTimeOnly_empty] /-- For a list `φs` of `𝓕.FieldOp`, then `𝓣(φs)` is equal to the sum of @@ -140,8 +134,8 @@ lemma timeOrder_haveEqTime_split (φs : List 𝓕.FieldOp) : φssucΛ.1.wickTerm) := by rw [wicks_theorem] simp only [wickTerm] - let e1 : WickContraction φs.length ≃ {φsΛ // HaveEqTime φsΛ} ⊕ {φsΛ // ¬ HaveEqTime φsΛ} := by - exact (Equiv.sumCompl HaveEqTime).symm + let e1 : WickContraction φs.length ≃ {φsΛ // HaveEqTime φsΛ} ⊕ {φsΛ // ¬ HaveEqTime φsΛ} := + (Equiv.sumCompl HaveEqTime).symm rw [← e1.symm.sum_comp] simp only [Equiv.symm_symm, Algebra.smul_mul_assoc, Fintype.sum_sum_type, Equiv.sumCompl_apply_inl, Equiv.sumCompl_apply_inr, ne_eq, e1] @@ -156,11 +150,7 @@ lemma timeOrder_haveEqTime_split (φs : List 𝓕.FieldOp) : simp only [f] conv_lhs => enter [2, φsucΛ] - rw [← Algebra.smul_mul_assoc] - rw [join_sign_timeContract φsΛ.1 φsucΛ.1] - conv_lhs => - enter [2, φsucΛ] - rw [mul_assoc] + rw [← Algebra.smul_mul_assoc, join_sign_timeContract φsΛ.1 φsucΛ.1, mul_assoc] rw [← Finset.mul_sum, ← Algebra.smul_mul_assoc] congr funext φsΛ' @@ -176,14 +166,9 @@ lemma normalOrder_timeOrder_ofFieldOpList_eq_not_haveEqTime_sub_inductive (φs : (∑ φssucΛ : { φssucΛ : WickContraction [φsΛ.1]ᵘᶜ.length // ¬ φssucΛ.HaveEqTime }, φssucΛ.1.wickTerm - 𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ))) := by rw [normalOrder_timeOrder_ofFieldOpList_eq_eqTimeOnly_empty, - timeOrder_haveEqTime_split] - rw [add_sub_assoc] + timeOrder_haveEqTime_split, add_sub_assoc] congr 1 - simp only [ne_eq, Algebra.smul_mul_assoc] - rw [← Finset.sum_sub_distrib] - congr 1 - funext x - rw [← smul_sub, ← mul_sub] + simp only [ne_eq, Algebra.smul_mul_assoc, ← Finset.sum_sub_distrib, ← smul_sub, ← mul_sub] lemma wicks_theorem_normal_order_empty : 𝓣(𝓝(ofFieldOpList [])) = ∑ (φsΛ : {φsΛ : WickContraction ([] : List 𝓕.FieldOp).length // ¬ HaveEqTime φsΛ}), @@ -196,27 +181,19 @@ lemma wicks_theorem_normal_order_empty : 𝓣(𝓝(ofFieldOpList [])) = left_inv := by intro a simp only [List.length_nil] - apply Subtype.ext - apply Subtype.ext - simp only [empty] + refine Subtype.ext (Subtype.ext ?_) ext i - simp only [Finset.notMem_empty, false_iff] - by_contra hn - have h2 := a.1.2.1 i hn - rw [@Finset.card_eq_two] at h2 - obtain ⟨a, b, ha, hb, hab⟩ := h2 - exact Fin.elim0 a, + simp only [empty, Finset.notMem_empty, false_iff] + exact fun hn => absurd (a.1.2.1 i hn) (by simp [Finset.eq_empty_of_isEmpty i]), right_inv := by intro a; simp} rw [← e2.symm.sum_comp] simp only [Finset.univ_unique, PUnit.default_eq_unit, List.length_nil, Equiv.coe_fn_symm_mk, sign_empty, timeContract_empty, OneMemClass.coe_one, one_smul, uncontractedListGet_empty, one_mul, Finset.sum_const, Finset.card_singleton, e2] have h1' : ofFieldOpList (𝓕 := 𝓕) [] = ofCrAnList [] := by rfl - rw [h1'] - rw [normalOrder_ofCrAnList] + rw [h1', normalOrder_ofCrAnList] simp only [normalOrderSign_nil, normalOrderList_nil, one_smul] - rw [ofCrAnList, timeOrder_eq_ι_timeOrderF] - rw [timeOrderF_ofCrAnListF] + rw [ofCrAnList, timeOrder_eq_ι_timeOrderF, timeOrderF_ofCrAnListF] simp /--For a list `φs` of `𝓕.FieldOp`, the normal-ordered version of Wick's theorem states that @@ -242,10 +219,7 @@ theorem wicks_theorem_normal_order : (φs : List 𝓕.FieldOp) → simp only [Algebra.smul_mul_assoc, ne_eq, add_eq_left] apply Finset.sum_eq_zero intro φsΛ hφsΛ - simp only [smul_eq_zero] - right - have ih := wicks_theorem_normal_order [φsΛ.1]ᵘᶜ - rw [ih] + rw [wicks_theorem_normal_order [φsΛ.1]ᵘᶜ] simp [wickTerm] termination_by φs => φs.length decreasing_by diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean index e9ae5dd39..729ca1304 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean @@ -45,19 +45,9 @@ lemma card_zero_iff_empty (c : WickContraction n) : c.1.card = 0 ↔ c = empty : lemma exists_pair_of_not_eq_empty (c : WickContraction n) (h : c ≠ empty) : ∃ i j, {i, j} ∈ c.1 := by - by_contra hn - simp only [not_exists] at hn - have hc : c.1 = ∅ := by - ext a - simp only [Finset.notMem_empty, iff_false] - by_contra hn' - have hc := c.2.1 a hn' - rw [@Finset.card_eq_two] at hc - obtain ⟨x, y, hx, rfl⟩ := hc - exact hn x y hn' - apply h - apply Subtype.ext_iff.mpr - simp [empty, hc] + obtain ⟨a, ha⟩ := Finset.nonempty_iff_ne_empty.mpr fun hc => h (Subtype.ext hc) + obtain ⟨i, j, -, rfl⟩ := Finset.card_eq_two.mp (c.2.1 a ha) + exact ⟨i, j, ha⟩ /-- The equivalence between `WickContraction n` and `WickContraction m` derived from a propositional equality of `n` and `m`. -/ @@ -76,18 +66,11 @@ lemma card_congr {n m : ℕ} (h : n = m) (c : WickContraction n) : lemma congr_contractions {n m : ℕ} (h : n = m) (c : WickContraction n) : ((congr h) c).1 = Finset.map (Finset.mapEmbedding (finCongr h)).toEmbedding c.1 := by subst h - simp only [congr_refl, Finset.le_eq_subset, finCongr_refl, Equiv.refl_toEmbedding] ext a - apply Iff.intro <;> intro ha - · simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding] - use a - simp only [ha, true_and] - rw [Finset.mapEmbedding_apply, Finset.map_refl] - · simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding] at ha - obtain ⟨b, hb, hab⟩ := ha - rw [Finset.mapEmbedding_apply, Finset.map_refl] at hab - subst hab - exact hb + simp only [congr_refl, Finset.mem_map, RelEmbedding.coe_toEmbedding, finCongr_refl, + Equiv.refl_toEmbedding] + exact ⟨fun ha => ⟨a, ha, Finset.map_refl⟩, + fun ⟨b, hb, hab⟩ => (Finset.map_refl.symm.trans hab) ▸ hb⟩ @[simp] lemma congr_trans {n m o : ℕ} (h1 : n = m) (h2 : m = o) : @@ -120,8 +103,7 @@ lemma congrLift_rfl {n : ℕ} {c : WickContraction n} : lemma congrLift_injective {n m : ℕ} {c : WickContraction n} (h : n = m) : Function.Injective (c.congrLift h) := by subst h - simp only [congrLift_rfl] - exact fun ⦃a₁ a₂⦄ a => a + simpa using Function.injective_id lemma congrLift_surjective {n m : ℕ} {c : WickContraction n} (h : n = m) : Function.Surjective (c.congrLift h) := by @@ -129,8 +111,8 @@ lemma congrLift_surjective {n m : ℕ} {c : WickContraction n} (h : n = m) : simp [Function.surjective_id] lemma congrLift_bijective {n m : ℕ} {c : WickContraction n} (h : n = m) : - Function.Bijective (c.congrLift h) := by - exact ⟨c.congrLift_injective h, c.congrLift_surjective h⟩ + Function.Bijective (c.congrLift h) := + ⟨c.congrLift_injective h, c.congrLift_surjective h⟩ /-- Given a contracted pair in `c : WickContraction n` the contracted pair in `congr h c`. -/ @@ -158,43 +140,27 @@ lemma getDual?_congr_get {n m : ℕ} (h : n = m) (c : WickContraction n) (i : Fi (hg : ((congr h c).getDual? i).isSome) : ((congr h c).getDual? i).get hg = (finCongr h ((c.getDual? (finCongr h.symm i)).get (by simpa [getDual?_congr] using hg))) := by - simp only [getDual?_congr, finCongr_apply] - exact Option.get_map + simpa only [getDual?_congr] using Option.get_map lemma getDual?_eq_some_iff_mem (i j : Fin n) : c.getDual? i = some j ↔ {i, j} ∈ c.1 := by - simp only [getDual?] - rw [Fin.find?_eq_some_iff] - apply Iff.intro <;> intro h - · simpa using h.1 - · simp [h, true_and] - intro k hkj hk - have hc := c.2.2 _ h _ hk - simp only [Finset.disjoint_insert_right, Finset.mem_insert, Finset.mem_singleton, true_or, - not_true_eq_false, Finset.disjoint_singleton_right, not_or, false_and, or_false] at hc - have hj : k ∈ ({i, j} : Finset (Fin n)) := by simp [hc] - simp only [Finset.mem_insert, Finset.mem_singleton] at hj - rcases hj with hj | hj - · subst hj - simp only [Finset.mem_singleton, Finset.insert_eq_of_mem] at hk - have hc := c.2.1 _ hk - simp at hc - · subst hj - simp at hkj + rw [getDual?, Fin.find?_eq_some_iff] + refine ⟨fun h => by simpa using h.1, fun h => ⟨by simpa using h, fun k hkj => ?_⟩⟩ + simp only [decide_eq_false_iff_not] + intro hk + rcases c.2.2 _ h _ hk with heq | hdisj + · have hkm : k = i ∨ k = j := by simpa using (Finset.ext_iff.mp heq k).mpr (by simp) + rcases hkm with rfl | rfl + · simpa using c.2.1 _ hk + · omega + · simpa using Finset.disjoint_left.mp hdisj (Finset.mem_insert_self i {j}) @[simp] lemma getDual?_one_eq_none (c : WickContraction 1) (i : Fin 1) : c.getDual? i = none := by by_contra h - have hn : (c.getDual? i).isSome := by - rw [← Option.not_isSome_iff_eq_none] at h - simpa [- Option.not_isSome, -Option.isNone_iff_eq_none] using h - rw [@Option.isSome_iff_exists] at hn - obtain ⟨a, hn⟩ := hn - rw [getDual?_eq_some_iff_mem] at hn - have hc := c.2.1 {i, a} hn - fin_cases i - fin_cases a - simp at hc + obtain ⟨a, ha⟩ := Option.ne_none_iff_exists'.mp h + rw [getDual?_eq_some_iff_mem] at ha + simpa [show a = i by omega] using c.2.1 _ ha @[simp] lemma getDual?_get_self_mem (i : Fin n) (h : (c.getDual? i).isSome) : @@ -209,56 +175,32 @@ lemma self_getDual?_get_mem (i : Fin n) (h : (c.getDual? i).isSome) : lemma getDual?_eq_some_neq (i j : Fin n) (h : c.getDual? i = some j) : ¬ i = j := by rw [getDual?_eq_some_iff_mem] at h - by_contra hn - subst hn - have hc := c.2.1 _ h - simp at hc + rintro rfl + simpa using c.2.1 _ h @[simp] lemma self_ne_getDual?_get (i : Fin n) (h : (c.getDual? i).isSome) : - ¬ i = (c.getDual? i).get h := by - by_contra hn - have hx : {i, (c.getDual? i).get h} ∈ c.1 := by simp - have hc := c.2.1 _ hx - nth_rewrite 1 [hn] at hc - simp at hc + ¬ i = (c.getDual? i).get h := + c.getDual?_eq_some_neq _ _ (Option.some_get h).symm @[simp] lemma getDual?_get_self_neq (i : Fin n) (h : (c.getDual? i).isSome) : - ¬ (c.getDual? i).get h = i := by - by_contra hn - have hx : {i, (c.getDual? i).get h} ∈ c.1 := by simp - have hc := c.2.1 _ hx - nth_rewrite 1 [hn] at hc - simp at hc + ¬ (c.getDual? i).get h = i := + Ne.symm (c.self_ne_getDual?_get i h) lemma getDual?_isSome_iff (i : Fin n) : (c.getDual? i).isSome ↔ ∃ (a : c.1), i ∈ a.1 := by - apply Iff.intro <;> intro h - · rw [getDual?, Fin.isSome_find?_iff] at h - obtain ⟨a, ha⟩ := h - use ⟨{i, a}, by simpa using ha⟩ - simp - · obtain ⟨a, ha⟩ := h - have ha := c.2.1 a a.2 - rw [@Finset.card_eq_two] at ha - obtain ⟨x, y, hx, hy⟩ := ha - rw [hy] at ha - simp only [Finset.mem_insert, Finset.mem_singleton] at ha - match ha with - | Or.inl ha => - subst ha - rw [getDual?, Fin.isSome_find?_iff] - exact ⟨y, by simpa using hy ▸ a.2⟩ - | Or.inr ha => - subst ha - rw [getDual?, Fin.isSome_find?_iff] - use x - rw [Finset.pair_comm] - simpa using hy ▸ a.2 - -lemma getDual?_isSome_of_mem (a : c.1) (i : a.1) : (c.getDual? i).isSome := by - rw [getDual?_isSome_iff] - exact ⟨⟨a.1, a.2⟩, Finset.coe_mem ..⟩ + simp only [Option.isSome_iff_exists, getDual?_eq_some_iff_mem] + refine ⟨fun ⟨j, hj⟩ => ⟨⟨_, hj⟩, Finset.mem_insert_self ..⟩, fun ⟨a, ha⟩ => ?_⟩ + obtain ⟨x, y, -, hxy⟩ := Finset.card_eq_two.mp (c.2.1 a a.2) + rw [hxy] at ha + simp only [Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl + · exact ⟨y, hxy ▸ a.2⟩ + · rw [Finset.pair_comm] at hxy + exact ⟨x, hxy ▸ a.2⟩ + +lemma getDual?_isSome_of_mem (a : c.1) (i : a.1) : (c.getDual? i).isSome := + (c.getDual?_isSome_iff i).mpr ⟨a, i.2⟩ @[simp] lemma getDual?_getDual?_get_get (i : Fin n) (h : (c.getDual? i).isSome) : @@ -308,58 +250,27 @@ lemma sndFieldOfContract_congr {n m : ℕ} (h : n = m) (c : WickContraction n) ( lemma finset_eq_fstFieldOfContract_sndFieldOfContract (c : WickContraction n) (a : c.1) : a.1 = {c.fstFieldOfContract a, c.sndFieldOfContract a} := by - have h1 := c.2.1 a.1 a.2 - rw [Finset.card_eq_two] at h1 - obtain ⟨x, y, hxy, ha⟩ := h1 + suffices h : ∀ x y : Fin n, x < y → a.1 = {x, y} → + a.1 = {c.fstFieldOfContract a, c.sndFieldOfContract a} by + obtain ⟨x, y, hxy, ha⟩ := Finset.card_eq_two.mp (c.2.1 a.1 a.2) + rcases lt_or_gt_of_ne hxy with h' | h' + · exact h x y h' ha + · exact h y x h' (ha.trans (Finset.pair_comm x y)) + intro x y hxy ha + have h1 : ∀ b ∈ ({y} : Finset (Fin n)), x ≤ b := by simp [hxy.le] + have hs : a.1.sort (· ≤ ·) = [x, y] := by + rw [ha, Finset.sort_insert _ h1 (by simp [hxy.ne]), Finset.sort_singleton] rw [ha] - by_cases hxyle : x ≤ y - · have ha : a.1.sort (· ≤ ·) = [x, y] := by - rw [ha] - trans Finset.sort (Finset.cons x {y} (by simp [hxy])) (· ≤ ·) - · congr - simp - rw [Finset.sort_cons] - simp only [Finset.sort_singleton] - intro b hb - simp only [Finset.mem_singleton] at hb - subst hb - omega - simp [fstFieldOfContract, ha, sndFieldOfContract] - · have ha : a.1.sort (· ≤ ·) = [y, x] := by - rw [ha] - trans Finset.sort (Finset.cons y {x} (by simp only [Finset.mem_singleton]; omega)) (· ≤ ·) - · congr - simp only [Finset.cons_eq_insert] - rw [@Finset.pair_comm] - rw [Finset.sort_cons] - simp only [Finset.sort_singleton] - intro b hb - simp only [Finset.mem_singleton] at hb - subst hb - omega - simp only [fstFieldOfContract, ha, List.head_cons, sndFieldOfContract, List.tail_cons] - rw [Finset.pair_comm] + simp [fstFieldOfContract, sndFieldOfContract, hs] lemma fstFieldOfContract_ne_sndFieldOfContract (c : WickContraction n) (a : c.1) : c.fstFieldOfContract a ≠ c.sndFieldOfContract a := by - have h1 := c.2.1 a.1 a.2 - have h2 := c.finset_eq_fstFieldOfContract_sndFieldOfContract a by_contra hn - simp [h2, hn] at h1 + simpa [c.finset_eq_fstFieldOfContract_sndFieldOfContract a, hn] using c.2.1 a.1 a.2 lemma fstFieldOfContract_le_sndFieldOfContract (c : WickContraction n) (a : c.1) : - c.fstFieldOfContract a ≤ c.sndFieldOfContract a := by - simp only [fstFieldOfContract, sndFieldOfContract, List.head_tail] - have h1 (n : ℕ) (l : List (Fin n)) (h : l ≠ []) (hl : l.Pairwise (· ≤ ·)) : - ∀ a ∈ l, l.head h ≤ a := by - induction l with - | nil => simp at h - | cons i l ih => - simp only [List.pairwise_cons] at hl - simpa using hl.1 - apply h1 - · exact Finset.pairwise_sort .. - · exact List.getElem_mem .. + c.fstFieldOfContract a ≤ c.sndFieldOfContract a := + (Finset.pairwise_sort ..).rel_head_tail (List.head_mem _) lemma fstFieldOfContract_lt_sndFieldOfContract (c : WickContraction n) (a : c.1) : c.fstFieldOfContract a < c.sndFieldOfContract a := @@ -372,9 +283,8 @@ lemma fstFieldOfContract_mem (c : WickContraction n) (a : c.1) : simp [finset_eq_fstFieldOfContract_sndFieldOfContract] lemma fstFieldOfContract_getDual?_isSome (c : WickContraction n) (a : c.1) : - (c.getDual? (c.fstFieldOfContract a)).isSome := by - rw [getDual?_isSome_iff] - exact ⟨a, fstFieldOfContract_mem ..⟩ + (c.getDual? (c.fstFieldOfContract a)).isSome := + (c.getDual?_isSome_iff _).mpr ⟨a, fstFieldOfContract_mem c a⟩ @[simp] lemma fstFieldOfContract_getDual? (c : WickContraction n) (a : c.1) : @@ -387,9 +297,8 @@ lemma sndFieldOfContract_mem (c : WickContraction n) (a : c.1) : simp [finset_eq_fstFieldOfContract_sndFieldOfContract] lemma sndFieldOfContract_getDual?_isSome (c : WickContraction n) (a : c.1) : - (c.getDual? (c.sndFieldOfContract a)).isSome := by - rw [getDual?_isSome_iff] - exact ⟨a, sndFieldOfContract_mem ..⟩ + (c.getDual? (c.sndFieldOfContract a)).isSome := + (c.getDual?_isSome_iff _).mpr ⟨a, sndFieldOfContract_mem c a⟩ @[simp] lemma sndFieldOfContract_getDual? (c : WickContraction n) (a : c.1) : @@ -400,42 +309,18 @@ lemma sndFieldOfContract_getDual? (c : WickContraction n) (a : c.1) : lemma eq_fstFieldOfContract_of_mem (c : WickContraction n) (a : c.1) (i j : Fin n) (hi : i ∈ a.1) (hj : j ∈ a.1) (hij : i < j) : c.fstFieldOfContract a = i := by + have hlt := fstFieldOfContract_lt_sndFieldOfContract c a rw [finset_eq_fstFieldOfContract_sndFieldOfContract] at hi hj - simp_all only [Finset.mem_insert, Finset.mem_singleton] - match hi, hj with - | Or.inl hi, Or.inl hj => - subst hi hj - simp at hij - | Or.inl hi, Or.inr hj => - subst hi - rfl - | Or.inr hi, Or.inl hj => - subst hi hj - have hn := fstFieldOfContract_lt_sndFieldOfContract c a - omega - | Or.inr hi, Or.inr hj => - subst hi hj - simp at hij + simp only [Finset.mem_insert, Finset.mem_singleton] at hi hj + rcases hi with rfl | rfl <;> rcases hj with rfl | rfl <;> omega lemma eq_sndFieldOfContract_of_mem (c : WickContraction n) (a : c.1) (i j : Fin n) (hi : i ∈ a.1) (hj : j ∈ a.1) (hij : i < j) : c.sndFieldOfContract a = j := by + have hlt := fstFieldOfContract_lt_sndFieldOfContract c a rw [finset_eq_fstFieldOfContract_sndFieldOfContract] at hi hj - simp_all only [Finset.mem_insert, Finset.mem_singleton] - match hi, hj with - | Or.inl hi, Or.inl hj => - subst hi hj - simp at hij - | Or.inl hi, Or.inr hj => - subst hi hj - omega - | Or.inr hi, Or.inl hj => - subst hi hj - have hn := fstFieldOfContract_lt_sndFieldOfContract c a - omega - | Or.inr hi, Or.inr hj => - subst hi hj - simp at hij + simp only [Finset.mem_insert, Finset.mem_singleton] at hi hj + rcases hi with rfl | rfl <;> rcases hj with rfl | rfl <;> omega /-- As a type, any pair of contractions is equivalent to `Fin 2` with `0` being associated with `c.fstFieldOfContract a` and `1` being associated with diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean b/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean index bc4cf4f25..bb0368b71 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean @@ -131,31 +131,14 @@ lemma insertAndContractNat_of_isSome (c : WickContraction n) (i : Fin n.succ) (j : Option c.uncontracted) (hj : j.isSome) : (insertAndContractNat c i j).1 = Insert.insert {i, i.succAbove (j.get hj)} (Finset.map (Finset.mapEmbedding i.succAboveEmb).toEmbedding c.1) := by - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset] - rw [@Option.isSome_iff_exists] at hj - obtain ⟨j, hj⟩ := hj - subst hj - simp + obtain ⟨j, rfl⟩ := Option.isSome_iff_exists.mp hj + simp [insertAndContractNat] @[simp] lemma self_mem_uncontracted_of_insertAndContractNat_none (c : WickContraction n) (i : Fin n.succ) : i ∈ (insertAndContractNat c i none).uncontracted := by - rw [mem_uncontracted_iff_not_contracted] - intro p hp - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_map, - RelEmbedding.coe_toEmbedding] at hp - obtain ⟨a, ha, ha'⟩ := hp - have hc := c.2.1 a ha - rw [@Finset.card_eq_two] at hc - obtain ⟨x, y, hxy, ha⟩ := hc - subst ha - subst ha' - rw [Finset.mapEmbedding_apply] - simp only [Nat.succ_eq_add_one, Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton, - Finset.mem_insert, Finset.mem_singleton, not_or] - apply And.intro - · exact Fin.ne_succAbove i x - · exact Fin.ne_succAbove i y + simp [mem_uncontracted_iff_not_contracted, insertAndContractNat, Finset.mapEmbedding_apply, + Fin.succAbove_ne, -Finset.le_eq_subset] @[simp] lemma self_not_mem_uncontracted_of_insertAndContractNat_some (c : WickContraction n) @@ -167,146 +150,32 @@ lemma self_not_mem_uncontracted_of_insertAndContractNat_some (c : WickContractio lemma insertAndContractNat_succAbove_mem_uncontracted_iff (c : WickContraction n) (i : Fin n.succ) (j : Fin n) : (i.succAbove j) ∈ (insertAndContractNat c i none).uncontracted ↔ j ∈ c.uncontracted := by - rw [mem_uncontracted_iff_not_contracted, mem_uncontracted_iff_not_contracted] - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_map, - RelEmbedding.coe_toEmbedding, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] - apply Iff.intro - · intro h p hp - have hp' := h p hp - have hc := c.2.1 p hp - rw [Finset.card_eq_two] at hc - obtain ⟨x, y, hxy, hp⟩ := hc - subst hp - rw [Finset.mapEmbedding_apply] at hp' - simp only [Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton, Finset.mem_insert, - Finset.mem_singleton, not_or] at hp' - simp only [Finset.mem_insert, Finset.mem_singleton, not_or] - exact And.intro (fun a => hp'.1 (congrArg i.succAbove a)) - (fun a => hp'.2 (congrArg i.succAbove a)) - · intro h p hp - have hc := c.2.1 p hp - rw [Finset.card_eq_two] at hc - obtain ⟨x, y, hxy, hp⟩ := hc - subst hp - rw [Finset.mapEmbedding_apply] - simp only [Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton, Finset.mem_insert, - Finset.mem_singleton, not_or] - have hp' := h {x, y} hp - simp only [Finset.mem_insert, Finset.mem_singleton, not_or] at hp' - apply And.intro - (fun a => hp'.1 (i.succAbove_right_injective a)) - (fun a => hp'.2 (i.succAbove_right_injective a)) + simp [mem_uncontracted_iff_not_contracted, insertAndContractNat, Finset.mapEmbedding_apply, + -Finset.le_eq_subset] @[simp] lemma mem_uncontracted_insertAndContractNat_none_iff (c : WickContraction n) (i : Fin n.succ) (k : Fin n.succ) : k ∈ (insertAndContractNat c i none).uncontracted ↔ k = i ∨ ∃ j, k = i.succAbove j ∧ j ∈ c.uncontracted := by - by_cases hi : k = i - · subst hi - simp - · simp only [Nat.succ_eq_add_one, ← Fin.exists_succAbove_eq_iff] at hi - obtain ⟨z, hk⟩ := hi - subst hk - have hn : ¬ i.succAbove z = i := Fin.succAbove_ne i z - simp only [Nat.succ_eq_add_one, insertAndContractNat_succAbove_mem_uncontracted_iff, hn, - false_or] - apply Iff.intro - · intro h - exact ⟨z, rfl, h⟩ - · intro h - obtain ⟨j, hk⟩ := h - have hjk : z = j := Fin.succAbove_right_inj.mp hk.1 - subst hjk - exact hk.2 + rcases Fin.eq_self_or_eq_succAbove i k with rfl | ⟨z, rfl⟩ + · simp + · simp [insertAndContractNat_succAbove_mem_uncontracted_iff, Fin.succAbove_ne] lemma insertAndContractNat_none_uncontracted (c : WickContraction n) (i : Fin n.succ) : (insertAndContractNat c i none).uncontracted = Insert.insert i (c.uncontracted.map i.succAboveEmb) := by ext a - simp only [Nat.succ_eq_add_one, mem_uncontracted_insertAndContractNat_none_iff, Finset.mem_insert, - Finset.mem_map, Fin.succAboveEmb_apply] - apply Iff.intro - · intro a_1 - cases a_1 with - | inl h => - subst h - simp_all only [true_or] - | inr h_1 => - obtain ⟨w, h⟩ := h_1 - obtain ⟨left, right⟩ := h - subst left - apply Or.inr - apply Exists.intro - · apply And.intro - on_goal 2 => {rfl - } - · simp_all only - · intro a_1 - cases a_1 with - | inl h => - subst h - simp_all only [true_or] - | inr h_1 => - obtain ⟨w, h⟩ := h_1 - obtain ⟨left, right⟩ := h - subst right - apply Or.inr - apply Exists.intro - · apply And.intro - on_goal 2 => {exact left - } - · simp_all only + simp [mem_uncontracted_insertAndContractNat_none_iff, and_comm, eq_comm] @[simp] lemma mem_uncontracted_insertAndContractNat_some_iff (c : WickContraction n) (i : Fin n.succ) (k : Fin n.succ) (j : c.uncontracted) : k ∈ (insertAndContractNat c i (some j)).uncontracted ↔ ∃ z, k = i.succAbove z ∧ z ∈ c.uncontracted ∧ z ≠ j := by - by_cases hki : k = i - · subst hki - simp only [Nat.succ_eq_add_one, self_not_mem_uncontracted_of_insertAndContractNat_some, ne_eq, - false_iff, not_exists, not_and, Decidable.not_not] - exact fun x hx => False.elim (Fin.ne_succAbove k x hx) - · simp only [Nat.succ_eq_add_one, ← Fin.exists_succAbove_eq_iff] at hki - obtain ⟨z, hk⟩ := hki - subst hk - by_cases hjz : j = z - · subst hjz - rw [mem_uncontracted_iff_not_contracted] - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_insert, - Finset.mem_map, RelEmbedding.coe_toEmbedding, forall_eq_or_imp, Finset.mem_singleton, - or_true, not_true_eq_false, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂, - false_and, ne_eq, false_iff, not_exists, not_and, Decidable.not_not] - intro x - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] - exact fun a _a => a.symm - · apply Iff.intro - · intro h - use z - simp only [Nat.succ_eq_add_one, ne_eq, true_and] - refine And.intro ?_ (fun a => hjz a.symm) - rw [mem_uncontracted_iff_not_contracted] - intro p hp - rw [mem_uncontracted_iff_not_contracted] at h - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, - Finset.mem_insert, Finset.mem_map, RelEmbedding.coe_toEmbedding, forall_eq_or_imp, - Finset.mem_singleton, not_or, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] at h - have hc := h.2 p hp - rw [Finset.mapEmbedding_apply] at hc - exact (Finset.mem_map' (i.succAboveEmb)).mpr.mt hc - · intro h - obtain ⟨z', hz'1, hz'⟩ := h - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at hz'1 - subst hz'1 - rw [mem_uncontracted_iff_not_contracted] - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, - Finset.mem_insert, Finset.mem_map, RelEmbedding.coe_toEmbedding, forall_eq_or_imp, - Finset.mem_singleton, not_or, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] - apply And.intro - · rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] - exact And.intro (Fin.succAbove_ne i z) (fun a => hjz a.symm) - · rw [mem_uncontracted_iff_not_contracted] at hz' - exact fun a ha hc => hz'.1 a ha ((Finset.mem_map' (i.succAboveEmb)).mp hc) + rcases Fin.eq_self_or_eq_succAbove i k with rfl | ⟨z, rfl⟩ + · simp [Fin.ne_succAbove] + · simp [insertAndContractNat, mem_uncontracted_iff_not_contracted, Fin.succAbove_ne, + Finset.mapEmbedding_apply, and_comm, -Finset.le_eq_subset] lemma insertAndContractNat_some_uncontracted (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) : @@ -315,24 +184,7 @@ lemma insertAndContractNat_some_uncontracted (c : WickContraction n) (i : Fin n. ext a simp only [Nat.succ_eq_add_one, mem_uncontracted_insertAndContractNat_some_iff, ne_eq, Finset.map_erase, Fin.succAboveEmb_apply, Finset.mem_erase, Finset.mem_map] - apply Iff.intro - · intro h - obtain ⟨z, h1, h2, h3⟩ := h - subst h1 - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] - simp only [h3, not_false_eq_true, true_and] - use z - · intro h - obtain ⟨z, h1, h2⟩ := h.2 - use z - subst h2 - simp only [true_and] - obtain ⟨a, ha1, ha2⟩ := h.2 - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at ha2 - subst ha2 - simp_all only [true_and] - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at h - exact h.1 + grind [Fin.succAbove_right_inj] /-! @@ -343,50 +195,36 @@ lemma insertAndContractNat_some_uncontracted (c : WickContraction n) (i : Fin n. set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_none_getDual?_isNone (c : WickContraction n) (i : Fin n.succ) : ((insertAndContractNat c i none).getDual? i).isNone := by - have hi : i ∈ (insertAndContractNat c i none).uncontracted := by - simp - simp only [Nat.succ_eq_add_one, uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hi - rw [hi] - simp + simp [Option.isNone_iff_eq_none, getDual?_eq_none_iff_mem_uncontracted] set_option backward.isDefEq.respectTransparency false in @[simp] lemma insertAndContractNat_none_getDual?_eq_none (c : WickContraction n) (i : Fin n.succ) : (insertAndContractNat c i none).getDual? i = none := by - have hi : i ∈ (insertAndContractNat c i none).uncontracted := by - simp - simp only [Nat.succ_eq_add_one, uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hi - rw [hi] + simp [getDual?_eq_none_iff_mem_uncontracted] @[simp] lemma insertAndContractNat_succAbove_getDual?_eq_none_iff (c : WickContraction n) (i : Fin n.succ) (j : Fin n) : (insertAndContractNat c i none).getDual? (i.succAbove j) = none ↔ c.getDual? j = none := by - have h1 := insertAndContractNat_succAbove_mem_uncontracted_iff c i j - simpa [uncontracted] using h1 + simpa [uncontracted] using insertAndContractNat_succAbove_mem_uncontracted_iff c i j @[simp] lemma insertAndContractNat_succAbove_getDual?_isSome_iff (c : WickContraction n) (i : Fin n.succ) (j : Fin n) : ((insertAndContractNat c i none).getDual? (i.succAbove j)).isSome ↔ (c.getDual? j).isSome := by - rw [← not_iff_not] - simp + simp [Option.isSome_iff_ne_none] @[simp] lemma insertAndContractNat_succAbove_getDual?_get (c : WickContraction n) (i : Fin n.succ) (j : Fin n) (h : ((insertAndContractNat c i none).getDual? (i.succAbove j)).isSome) : ((insertAndContractNat c i none).getDual? (i.succAbove j)).get h = i.succAbove ((c.getDual? j).get (by simpa using h)) := by - have h1 : (insertAndContractNat c i none).getDual? (i.succAbove j) = some - (i.succAbove ((c.getDual? j).get (by simpa using h))) := by - rw [getDual?_eq_some_iff_mem] - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_map, - RelEmbedding.coe_toEmbedding] - use {j, ((c.getDual? j).get (by simpa using h))} - simp only [self_getDual?_get_mem, true_and] - rw [Finset.mapEmbedding_apply] - simp - exact Option.get_of_mem h h1 + refine Option.get_of_mem h ((getDual?_eq_some_iff_mem _ _ _).mpr ?_) + simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.mem_map, + RelEmbedding.coe_toEmbedding] + exact ⟨_, self_getDual?_get_mem c j (by simpa using h), + by simp [Finset.mapEmbedding_apply, -Finset.le_eq_subset]⟩ @[simp] lemma insertAndContractNat_some_getDual?_eq (c : WickContraction n) (i : Fin n.succ) @@ -398,30 +236,13 @@ lemma insertAndContractNat_some_getDual?_eq (c : WickContraction n) (i : Fin n.s lemma insertAndContractNat_some_getDual?_ne_none (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) : (insertAndContractNat c i (some j)).getDual? (i.succAbove k) = none ↔ c.getDual? k = none := by - apply Iff.intro - · intro h - have hk : (i.succAbove k) ∈ (insertAndContractNat c i (some j)).uncontracted := by - simp only [Nat.succ_eq_add_one, uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] - exact h - simp only [Nat.succ_eq_add_one, mem_uncontracted_insertAndContractNat_some_iff, ne_eq] at hk - obtain ⟨z, hz1, hz2, hz3⟩ := hk - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at hz1 - subst hz1 - simpa [uncontracted] using hz2 - · intro h - have hk : (i.succAbove k) ∈ (insertAndContractNat c i (some j)).uncontracted := by - simp only [Nat.succ_eq_add_one, mem_uncontracted_insertAndContractNat_some_iff, ne_eq] - use k - simp only [hkj, not_false_eq_true, and_true, true_and] - simpa [uncontracted] using h - simpa [uncontracted, -mem_uncontracted_insertAndContractNat_some_iff, ne_eq] using hk + simp [getDual?_eq_none_iff_mem_uncontracted, hkj] lemma insertAndContractNat_some_getDual?_ne_isSome (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) : ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)).isSome ↔ (c.getDual? k).isSome := by - rw [← not_iff_not] - simp [hkj, insertAndContractNat_some_getDual?_ne_none] + simp [Option.isSome_iff_ne_none, insertAndContractNat_some_getDual?_ne_none c i j k hkj] lemma insertAndContractNat_some_getDual?_ne_isSome_get (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) @@ -429,40 +250,25 @@ lemma insertAndContractNat_some_getDual?_ne_isSome_get (c : WickContraction n) ( ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)).get h = i.succAbove ((c.getDual? k).get (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h)) := by - have h1 : ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)) - = some (i.succAbove ((c.getDual? k).get - (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h))) := by - rw [getDual?_eq_some_iff_mem] - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_insert, - Finset.mem_map, RelEmbedding.coe_toEmbedding] - apply Or.inr - use { k, ((c.getDual? k).get - (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h))} - simp only [self_getDual?_get_mem, true_and] - rw [Finset.mapEmbedding_apply] - simp - exact Option.get_of_mem h h1 + refine Option.get_of_mem h ((getDual?_eq_some_iff_mem _ _ _).mpr ?_) + simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.mem_insert, + Finset.mem_map, RelEmbedding.coe_toEmbedding] + exact Or.inr ⟨_, self_getDual?_get_mem c k + (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h), + by simp [Finset.mapEmbedding_apply, -Finset.le_eq_subset]⟩ @[simp] lemma insertAndContractNat_some_getDual?_of_neq (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) : (insertAndContractNat c i (some j)).getDual? (i.succAbove k) = Option.map i.succAbove (c.getDual? k) := by - by_cases h : (c.getDual? k).isSome - · have h1 : (c.insertAndContractNat i (some j)).getDual? (i.succAbove k) = - some (i.succAbove ((c.getDual? k).get h)) := by - rw [← insertAndContractNat_some_getDual?_ne_isSome_get c i j k hkj] - refine Eq.symm (Option.some_get ?_) - all_goals - simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h - rw [h1] - have h2 :(c.getDual? k) = some ((c.getDual? k).get h) := by simp - conv_rhs => rw [h2] - rw [@Option.map_coe'] - · simp only [Bool.not_eq_true, Option.isSome_eq_false_iff, Option.isNone_iff_eq_none] at h - simp only [Nat.succ_eq_add_one, h, Option.map_none] - simp only [ne_eq, hkj, not_false_eq_true, insertAndContractNat_some_getDual?_ne_none] - exact h + rcases hc : c.getDual? k with _ | d + · simp [hc, insertAndContractNat_some_getDual?_ne_none c i j k hkj] + · rw [Option.map_some, getDual?_eq_some_iff_mem] + simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.mem_insert, + Finset.mem_map, RelEmbedding.coe_toEmbedding] + exact Or.inr ⟨{k, d}, (c.getDual?_eq_some_iff_mem k d).mp hc, + by simp [Finset.mapEmbedding_apply, -Finset.le_eq_subset]⟩ /-! @@ -473,48 +279,17 @@ lemma insertAndContractNat_some_getDual?_of_neq (c : WickContraction n) (i : Fin @[simp] lemma insertAndContractNat_erase (c : WickContraction n) (i : Fin n.succ) (j : Option c.uncontracted) : erase (insertAndContractNat c i j) i = c := by - refine Subtype.ext ?_ - simp only [erase, Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset] - conv_rhs => rw [c.eq_filter_mem_self] - refine Finset.filter_inj'.mpr ?_ - intro a _ + refine Subtype.ext (Finset.ext fun a => ?_) + simp only [erase, Nat.succ_eq_add_one, insertAndContractNat, Finset.mem_filter, Finset.mem_univ, + true_and] match j with | none => - simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding] - apply Iff.intro - · intro ha - obtain ⟨a', ha', ha''⟩ := ha - rw [Finset.mapEmbedding_apply] at ha'' - simp only [Finset.map_inj] at ha'' - subst ha'' - exact ha' - · intro ha - use a - simp only [ha, true_and] - rw [Finset.mapEmbedding_apply] + simp [Finset.mapEmbedding_apply, Finset.map_inj, -Finset.le_eq_subset] | some j => - simp only [Finset.mem_insert, Finset.mem_map, RelEmbedding.coe_toEmbedding] - apply Iff.intro - · intro ha - rcases ha with ha | ha - · have hin : ¬ i ∈ Finset.map i.succAboveEmb a := by - simp only [Nat.succ_eq_add_one, Finset.mem_map, Fin.succAboveEmb_apply, not_exists, - not_and] - intro x - exact fun a => Fin.succAbove_ne i x - refine False.elim (hin ?_) - rw [ha] - simp - · obtain ⟨a', ha', ha''⟩ := ha - rw [Finset.mapEmbedding_apply] at ha'' - simp only [Finset.map_inj] at ha'' - subst ha'' - exact ha' - · intro ha - apply Or.inr - use a - simp only [ha, true_and] - rw [Finset.mapEmbedding_apply] + have hn : Finset.map i.succAboveEmb a ≠ {i, i.succAbove j} := fun h => by + have hi : i ∈ Finset.map i.succAboveEmb a := h ▸ Finset.mem_insert_self i _ + simp [Fin.succAbove_ne] at hi + simp [Finset.mapEmbedding_apply, Finset.map_inj, hn, -Finset.le_eq_subset] set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_getDualErase (c : WickContraction n) (i : Fin n.succ) @@ -522,18 +297,14 @@ lemma insertAndContractNat_getDualErase (c : WickContraction n) (i : Fin n.succ) uncontractedCongr (c := c) (c' := (c.insertAndContractNat i j).erase i) (by simp) j := by match n with | 0 => - simp only [insertAndContractNat, Nat.succ_eq_add_one, Nat.reduceAdd, Finset.le_eq_subset, - getDualErase] fin_cases j - simp + simp [getDualErase] | Nat.succ n => match j with | none => simp [getDualErase] | some j => - simp only [Nat.succ_eq_add_one, getDualErase, insertAndContractNat_some_getDual?_eq, - Option.isSome_some, ↓reduceDIte, Option.get_some, predAboveI_succAbove, - uncontractedCongr_some, Option.some.injEq] + simp [getDualErase] rfl @[simp] @@ -546,23 +317,12 @@ lemma erase_insert (c : WickContraction n.succ) (i : Fin n.succ) : Finset.le_eq_subset] ext a simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding] - apply Iff.intro - · intro h - simp only [erase, Nat.reduceAdd, Nat.succ_eq_add_one, Finset.mem_filter, Finset.mem_univ, - true_and] at h - obtain ⟨a', ha', ha''⟩ := h - subst ha'' - exact ha' + constructor + · rintro ⟨a', ha', rfl⟩ + exact (Finset.mem_filter.mp ha').2 · intro ha - obtain ⟨a, ha⟩ := c.mem_not_eq_erase_of_isNone (a := a) i (by simp) ha - simp_all only [Nat.succ_eq_add_one] - obtain ⟨left, right⟩ := ha - subst right - apply Exists.intro - · apply And.intro - on_goal 2 => {rfl - } - · simp_all only + obtain ⟨a', ha', rfl⟩ := c.mem_not_eq_erase_of_isNone (a := a) i (by simp) ha + exact ⟨a', ha', rfl⟩ | Nat.succ n => apply Subtype.ext by_cases hi : (c.getDual? i).isSome @@ -570,52 +330,29 @@ lemma erase_insert (c : WickContraction n.succ) (i : Fin n.succ) : simp only [Nat.succ_eq_add_one, getDualErase, hi, ↓reduceDIte, Option.get_some, Finset.le_eq_subset] rw [succsAbove_predAboveI] - ext a - apply Iff.intro - · simp only [Finset.mem_insert, Finset.mem_map, RelEmbedding.coe_toEmbedding] - intro ha - rcases ha with ha | ha - · subst ha - simp - · obtain ⟨a', ha', ha''⟩ := ha - subst ha'' - simp_all only [Nat.succ_eq_add_one, erase, Finset.mem_filter, Finset.mem_univ, true_and] - exact ha' - · intro ha + · ext a simp only [Finset.mem_insert, Finset.mem_map, RelEmbedding.coe_toEmbedding] - by_cases hia : a = {i, (c.getDual? i).get hi} - · subst hia - simp - · apply Or.inr - simp only [erase, Nat.succ_eq_add_one, Finset.mem_filter, Finset.mem_univ, true_and] - obtain ⟨a', ha'⟩ := c.mem_not_eq_erase_of_isSome (a := a) i hi ha hia - use a' - simp_all only [Nat.succ_eq_add_one, true_and] - obtain ⟨left, right⟩ := ha' - subst right - rfl - simp only [Nat.succ_eq_add_one, ne_eq, self_ne_getDual?_get, not_false_eq_true] - exact (getDualErase_isSome_iff_getDual?_isSome c i).mpr hi + constructor + · rintro (rfl | ⟨a', ha', rfl⟩) + · simp + · exact (Finset.mem_filter.mp ha').2 + · intro ha + by_cases hia : a = {i, (c.getDual? i).get hi} + · exact Or.inl hia + · obtain ⟨a', ha', rfl⟩ := c.mem_not_eq_erase_of_isSome (a := a) i hi ha hia + exact Or.inr ⟨a', ha', rfl⟩ + · simp + · exact (getDualErase_isSome_iff_getDual?_isSome c i).mpr hi · simp only [Nat.succ_eq_add_one, insertAndContractNat, getDualErase, hi, Bool.false_eq_true, ↓reduceDIte, Finset.le_eq_subset] ext a simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding] - apply Iff.intro - · intro h - simp only [erase, Nat.succ_eq_add_one, Finset.mem_filter, Finset.mem_univ, true_and] at h - obtain ⟨a', ha', ha''⟩ := h - subst ha'' - exact ha' + constructor + · rintro ⟨a', ha', rfl⟩ + exact (Finset.mem_filter.mp ha').2 · intro ha - obtain ⟨a, ha⟩ := c.mem_not_eq_erase_of_isNone (a := a) i (by simpa using hi) ha - simp_all only [Nat.succ_eq_add_one, Bool.not_eq_true] - obtain ⟨left, right⟩ := ha - subst right - apply Exists.intro - · apply And.intro - on_goal 2 => {rfl - } - · simp_all only + obtain ⟨a', ha', rfl⟩ := c.mem_not_eq_erase_of_isNone (a := a) i (by simpa using hi) ha + exact ⟨a', ha', rfl⟩ /-- Lifts a contraction in `c` to a contraction in `(c.insert i j)`. -/ def insertLift {c : WickContraction n} (i : Fin n.succ) (j : Option (c.uncontracted)) @@ -635,56 +372,40 @@ def insertLift {c : WickContraction n} (i : Fin n.succ) (j : Option (c.uncontrac rfl⟩ lemma insertLift_injective {c : WickContraction n} (i : Fin n.succ) (j : Option (c.uncontracted)) : - Function.Injective (insertLift i j) := by - intro a b hab - simp only [Nat.succ_eq_add_one, insertLift, Subtype.mk.injEq, Finset.map_inj] at hab - exact Subtype.ext hab + Function.Injective (insertLift i j) := fun _ _ hab => + Subtype.ext (Finset.map_injective _ (Subtype.ext_iff.mp hab)) lemma insertLift_none_surjective {c : WickContraction n} (i : Fin n.succ) : Function.Surjective (c.insertLift i none) := by intro a - have ha := a.2 - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_map, - RelEmbedding.coe_toEmbedding] at ha - obtain ⟨a', ha', ha''⟩ := ha - use ⟨a', ha'⟩ - exact Subtype.ext ha'' + obtain ⟨a', ha', ha''⟩ := Finset.mem_map.mp a.2 + exact ⟨⟨a', ha'⟩, Subtype.ext ha''⟩ lemma insertLift_none_bijective {c : WickContraction n} (i : Fin n.succ) : - Function.Bijective (c.insertLift i none) := by - exact ⟨insertLift_injective i none, insertLift_none_surjective i⟩ + Function.Bijective (c.insertLift i none) := + ⟨insertLift_injective i none, insertLift_none_surjective i⟩ @[simp] lemma insertAndContractNat_fstFieldOfContract (c : WickContraction n) (i : Fin n.succ) (j : Option (c.uncontracted)) (a : c.1) : (c.insertAndContractNat i j).fstFieldOfContract (insertLift i j a) = - i.succAbove (c.fstFieldOfContract a) := by - refine (c.insertAndContractNat i j).eq_fstFieldOfContract_of_mem (a := (insertLift i j a)) - (i := i.succAbove (c.fstFieldOfContract a)) (j := i.succAbove (c.sndFieldOfContract a)) ?_ ?_ ?_ - · simp only [Nat.succ_eq_add_one, insertLift, Finset.mem_map, Fin.succAboveEmb_apply] - use (c.fstFieldOfContract a) - simp - · simp only [Nat.succ_eq_add_one, insertLift, Finset.mem_map, Fin.succAboveEmb_apply] - use (c.sndFieldOfContract a) - simp - · refine Fin.succAbove_lt_succAbove_iff.mpr ?_ - exact fstFieldOfContract_lt_sndFieldOfContract c a + i.succAbove (c.fstFieldOfContract a) := + (c.insertAndContractNat i j).eq_fstFieldOfContract_of_mem (insertLift i j a) + (i.succAbove (c.fstFieldOfContract a)) (i.succAbove (c.sndFieldOfContract a)) + (Finset.mem_map_of_mem _ (fstFieldOfContract_mem c a)) + (Finset.mem_map_of_mem _ (sndFieldOfContract_mem c a)) + (Fin.succAbove_lt_succAbove_iff.mpr (fstFieldOfContract_lt_sndFieldOfContract c a)) @[simp] lemma insertAndContractNat_sndFieldOfContract (c : WickContraction n) (i : Fin n.succ) (j : Option (c.uncontracted)) (a : c.1) : (c.insertAndContractNat i j).sndFieldOfContract (insertLift i j a) = - i.succAbove (c.sndFieldOfContract a) := by - refine (c.insertAndContractNat i j).eq_sndFieldOfContract_of_mem (a := (insertLift i j a)) - (i := i.succAbove (c.fstFieldOfContract a)) (j := i.succAbove (c.sndFieldOfContract a)) ?_ ?_ ?_ - · simp only [Nat.succ_eq_add_one, insertLift, Finset.mem_map, Fin.succAboveEmb_apply] - use (c.fstFieldOfContract a) - simp - · simp only [Nat.succ_eq_add_one, insertLift, Finset.mem_map, Fin.succAboveEmb_apply] - use (c.sndFieldOfContract a) - simp - · refine Fin.succAbove_lt_succAbove_iff.mpr ?_ - exact fstFieldOfContract_lt_sndFieldOfContract c a + i.succAbove (c.sndFieldOfContract a) := + (c.insertAndContractNat i j).eq_sndFieldOfContract_of_mem (insertLift i j a) + (i.succAbove (c.fstFieldOfContract a)) (i.succAbove (c.sndFieldOfContract a)) + (Finset.mem_map_of_mem _ (fstFieldOfContract_mem c a)) + (Finset.mem_map_of_mem _ (sndFieldOfContract_mem c a)) + (Fin.succAbove_lt_succAbove_iff.mpr (fstFieldOfContract_lt_sndFieldOfContract c a)) /-- Given a contracted pair for a Wick contraction `WickContraction n`, the corresponding contracted pair of a wick contraction `(c.insert i (some j))` formed @@ -701,47 +422,20 @@ lemma insertLiftSome_injective {c : WickContraction n} (i : Fin n.succ) (j : c.u intro a b hab match a, b with | Sum.inl (), Sum.inl () => rfl - | Sum.inl (), Sum.inr a => - simp only [Nat.succ_eq_add_one, insertLiftSome, insertLift, Subtype.mk.injEq] at hab - rw [finset_eq_fstFieldOfContract_sndFieldOfContract] at hab - simp only [Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton] at hab - have hi : i ∈ ({i.succAbove (c.fstFieldOfContract a), - i.succAbove (c.sndFieldOfContract a)} : Finset (Fin (n + 1))) := by - rw [← hab] - simp - simp only [Nat.succ_eq_add_one, Finset.mem_insert, Finset.mem_singleton] at hi - rcases hi with hi | hi - · exact False.elim (Fin.ne_succAbove _ _ hi) - · exact False.elim (Fin.ne_succAbove _ _ hi) - | Sum.inr a, Sum.inl () => + | Sum.inl (), Sum.inr a | Sum.inr a, Sum.inl () => simp only [Nat.succ_eq_add_one, insertLiftSome, insertLift, Subtype.mk.injEq] at hab - rw [finset_eq_fstFieldOfContract_sndFieldOfContract] at hab - simp only [Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton] at hab - have hi : i ∈ ({i.succAbove (c.fstFieldOfContract a), - i.succAbove (c.sndFieldOfContract a)} : Finset (Fin (n + 1))) := by - rw [hab] - simp - simp only [Nat.succ_eq_add_one, Finset.mem_insert, Finset.mem_singleton] at hi - rcases hi with hi | hi - · exact False.elim (Fin.ne_succAbove _ _ hi) - · exact False.elim (Fin.ne_succAbove _ _ hi) + have hi : i ∈ Finset.map (Fin.succAboveEmb i) a.1 := hab ▸ Finset.mem_insert_self i _ + simp [Fin.succAbove_ne] at hi | Sum.inr a, Sum.inr b => - simp only [Nat.succ_eq_add_one, insertLiftSome] at hab - simpa using insertLift_injective i (some j) hab + exact congrArg Sum.inr (insertLift_injective i (some j) hab) lemma insertLiftSome_surjective {c : WickContraction n} (i : Fin n.succ) (j : c.uncontracted) : Function.Surjective (insertLiftSome i j) := by intro a - have ha := a.2 - simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_insert, - Finset.mem_map, RelEmbedding.coe_toEmbedding] at ha - rcases ha with ha | ha - · use Sum.inl () - exact Subtype.ext ha.symm - · obtain ⟨a', ha', ha''⟩ := ha - use Sum.inr ⟨a', ha'⟩ - simp only [Nat.succ_eq_add_one, insertLiftSome, insertLift] - exact Subtype.ext ha'' + rcases Finset.mem_insert.mp a.2 with ha | ha + · exact ⟨Sum.inl (), Subtype.ext ha.symm⟩ + · obtain ⟨a', ha', ha''⟩ := Finset.mem_map.mp ha + exact ⟨Sum.inr ⟨a', ha'⟩, Subtype.ext ha''⟩ lemma insertLiftSome_bijective {c : WickContraction n} (i : Fin n.succ) (j : c.uncontracted) : Function.Bijective (insertLiftSome i j) := @@ -755,61 +449,19 @@ lemma insertLiftSome_bijective {c : WickContraction n} (i : Fin n.succ) (j : c.u set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_injective (i : Fin n.succ) : - Function.Injective (fun c => insertAndContractNat c i none) := by - intro c1 c2 hc1c2 - rw [Subtype.ext_iff] at hc1c2 - simp [insertAndContractNat] at hc1c2 - exact Subtype.ext hc1c2 + Function.Injective (fun c => insertAndContractNat c i none) := fun _ _ hc => + Subtype.ext (by simpa [insertAndContractNat] using Subtype.ext_iff.mp hc) lemma insertAndContractNat_surjective_on_nodual (i : Fin n.succ) (c : WickContraction n.succ) (hc : c.getDual? i = none) : ∃ c', insertAndContractNat c' i none = c := by - use c.erase i - apply Subtype.ext - ext a - simp [insertAndContractNat, erase] - apply Iff.intro - · intro h - obtain ⟨a', ha', rfl⟩ := h - exact ha' - · intro h - have hi : i ∈ c.uncontracted := by - simpa [uncontracted] using hc - rw [mem_uncontracted_iff_not_contracted] at hi - obtain ⟨j, hj⟩ := (@Fin.exists_succAbove_eq_iff _ i (c.fstFieldOfContract ⟨a, h⟩)).mpr - (by - by_contra hn - apply hi a h - change i ∈ (⟨a, h⟩ : c.1).1 - rw [finset_eq_fstFieldOfContract_sndFieldOfContract c ⟨a, h⟩] - subst hn - simp) - obtain ⟨k, hk⟩ := (@Fin.exists_succAbove_eq_iff _ i (c.sndFieldOfContract ⟨a, h⟩)).mpr - (by - by_contra hn - apply hi a h - change i ∈ (⟨a, h⟩ : c.1).1 - rw [finset_eq_fstFieldOfContract_sndFieldOfContract c ⟨a, h⟩] - subst hn - simp) - use {j, k} - rw [Finset.mapEmbedding_apply] - simp only [Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton] - rw [hj, hk] - rw [← finset_eq_fstFieldOfContract_sndFieldOfContract c ⟨a, h⟩] - simp only [and_true] - exact h + have h0 : c.getDualErase i = none := Option.not_isSome_iff_eq_none.mp (by simp [hc]) + exact ⟨c.erase i, h0 ▸ erase_insert c i⟩ lemma insertAndContractNat_bijective (i : Fin n.succ) : Function.Bijective (fun c => (⟨insertAndContractNat c i none, by simp⟩ : {c : WickContraction n.succ // c.getDual? i = none})) := by - apply And.intro - · intro a b hab - simp only [Nat.succ_eq_add_one, Subtype.mk.injEq] at hab - exact insertAndContractNat_injective i hab - · intro c - obtain ⟨c', hc'⟩ := insertAndContractNat_surjective_on_nodual i c c.2 - use c' - simp [hc'] + refine ⟨fun a b hab => insertAndContractNat_injective i (by simpa using hab), fun c => ?_⟩ + exact (insertAndContractNat_surjective_on_nodual i c c.2).imp fun _ => Subtype.ext end WickContraction diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean index bab630d6a..822f77b54 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean @@ -82,40 +82,34 @@ lemma fromInvolution_getDual?_isSome (f : {f : Fin n → Fin n // Function.Invol obtain ⟨j, h⟩ := ha2.2 rw [← h] at ha have hj : f.1 j ≠ j := by - by_contra hn + intro hn rw [hn] at h - rw [← h] at ha2 - simp at ha2 + simp [← h] at ha2 simp only [Finset.mem_insert, Finset.mem_singleton] at ha - rcases ha with ha | ha - · subst ha - exact hj - · subst ha - rw [f.2] - exact id (Ne.symm hj) + rcases ha with rfl | rfl + · exact hj + · rw [f.2] + exact hj.symm · intro hi use ⟨{i, f.1 i}, by simp only [fromInvolution, Finset.mem_filter, Finset.mem_univ, exists_apply_eq_apply, and_true, true_and] - rw [Finset.card_pair (id (Ne.symm hi))]⟩ + exact Finset.card_pair hi.symm⟩ simp lemma fromInvolution_getDual?_eq_some (f : {f : Fin n → Fin n // Function.Involutive f}) (i : Fin n) (h : ((fromInvolution f).getDual? i).isSome) : ((fromInvolution f).getDual? i) = some (f.1 i) := by - rw [@getDual?_eq_some_iff_mem] + rw [getDual?_eq_some_iff_mem] simp only [fromInvolution, Finset.mem_filter, Finset.mem_univ, exists_apply_eq_apply, and_true, true_and] - apply Finset.card_pair - simp only [fromInvolution_getDual?_isSome, ne_eq] at h - exact fun a => h (id (Eq.symm a)) + exact Finset.card_pair (Ne.symm ((fromInvolution_getDual?_isSome f i).mp h)) @[simp] lemma fromInvolution_getDual?_get (f : {f : Fin n → Fin n // Function.Involutive f}) (i : Fin n) (h : ((fromInvolution f).getDual? i).isSome) : - ((fromInvolution f).getDual? i).get h = (f.1 i) := by - have h1 := fromInvolution_getDual?_eq_some f i h - exact Option.get_of_mem h h1 + ((fromInvolution f).getDual? i).get h = (f.1 i) := + Option.get_of_mem h (fromInvolution_getDual?_eq_some f i h) lemma toInvolution_fromInvolution : fromInvolution c.toInvolution = c := by apply Subtype.ext @@ -128,15 +122,12 @@ lemma toInvolution_fromInvolution : fromInvolution c.toInvolution = c := by split at hi · subst hi simp - · simp only [Finset.mem_singleton, Finset.insert_eq_of_mem] at hi - subst hi - simp at h + · subst hi + simp [Finset.insert_eq_of_mem] at h · intro ha - apply And.intro (c.2.1 a ha) - use c.fstFieldOfContract ⟨a, ha⟩ + refine ⟨c.2.1 a ha, c.fstFieldOfContract ⟨a, ha⟩, ?_⟩ simp only [fstFieldOfContract_getDual?, Option.isSome_some, ↓reduceDIte, Option.get_some] - change _ = (⟨a, ha⟩ : c.1).1 - conv_rhs => rw [finset_eq_fstFieldOfContract_sndFieldOfContract] + exact (finset_eq_fstFieldOfContract_sndFieldOfContract c ⟨a, ha⟩).symm lemma fromInvolution_toInvolution (f : {f : Fin n → Fin n // Function.Involutive f}) : (fromInvolution f).toInvolution = f := by @@ -144,11 +135,10 @@ lemma fromInvolution_toInvolution (f : {f : Fin n → Fin n // Function.Involuti funext i simp only [toInvolution] split - · rename_i h - simp + · simp · rename_i h simp only [fromInvolution_getDual?_isSome, ne_eq, Decidable.not_not] at h - exact id (Eq.symm h) + exact h.symm /-- The equivalence between Wick contractions for `n` and involutions of `Fin n`. The involution of `Fin n` associated with a Wick contraction `c : WickContraction n` as follows. diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean index 5540142ca..2eefa3cc7 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean @@ -83,9 +83,8 @@ lemma jointLiftLeft_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Injective (@joinLiftLeft _ _ φsΛ φsucΛ) := by intro a b h - simp only [joinLiftLeft] at h - rw [Subtype.mk_eq_mk] at h - refine Subtype.ext h + simp only [joinLiftLeft, Subtype.mk_eq_mk] at h + exact Subtype.ext h /-- Given a contracting pair within `φsucΛ` the corresponding contracting pair within `(join φsΛ φsucΛ)`. -/ @@ -103,29 +102,22 @@ lemma joinLiftRight_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Injective (@joinLiftRight _ _ φsΛ φsucΛ) := by intro a b h - simp only [joinLiftRight] at h - rw [Subtype.mk_eq_mk] at h - simp only [Finset.map_inj] at h - refine Subtype.ext h + simp only [joinLiftRight, Subtype.mk_eq_mk, Finset.map_inj] at h + exact Subtype.ext h lemma jointLiftLeft_disjoint_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} (a : φsΛ.1) (b : φsucΛ.1) : - Disjoint (@joinLiftLeft _ _ _ φsucΛ a).1 (joinLiftRight b).1 := by - simp only [joinLiftLeft, joinLiftRight] - symm - apply uncontractedListEmd_finset_disjoint_left - exact a.2 + Disjoint (@joinLiftLeft _ _ _ φsucΛ a).1 (joinLiftRight b).1 := + (uncontractedListEmd_finset_disjoint_left b.1 a.1 a.2).symm lemma jointLiftLeft_ne_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} (a : φsΛ.1) (b : φsucΛ.1) : joinLiftLeft a ≠ joinLiftRight b := by by_contra hn have h1 := jointLiftLeft_disjoint_joinLiftRight a b - rw [hn] at h1 - simp only [disjoint_self, Finset.bot_eq_empty] at h1 + rw [hn, disjoint_self, Finset.bot_eq_empty] at h1 have hj := (join φsΛ φsucΛ).2.1 (joinLiftRight b).1 (joinLiftRight b).2 - rw [h1] at hj - simp at hj + simp [h1] at hj /-- The map from contracted pairs of `φsΛ` and `φsucΛ` to contracted pairs in `(join φsΛ φsucΛ)`. -/ @@ -140,19 +132,13 @@ lemma joinLift_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs. intro a b h match a, b with | Sum.inl a, Sum.inl b => - simp only [Sum.inl.injEq] - exact jointLiftLeft_injective h + exact congrArg Sum.inl (jointLiftLeft_injective h) | Sum.inr a, Sum.inr b => - simp only [Sum.inr.injEq] - exact joinLiftRight_injective h + exact congrArg Sum.inr (joinLiftRight_injective h) | Sum.inl a, Sum.inr b => - simp only [joinLift] at h - have h1 := jointLiftLeft_ne_joinLiftRight a b - simp_all + exact absurd h (jointLiftLeft_ne_joinLiftRight a b) | Sum.inr a, Sum.inl b => - simp only [joinLift] at h - have h1 := jointLiftLeft_ne_joinLiftRight b a - simp_all + exact absurd h.symm (jointLiftLeft_ne_joinLiftRight b a) lemma joinLift_surjective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Surjective (@joinLift _ _ φsΛ φsucΛ) := by @@ -170,17 +156,14 @@ lemma joinLift_surjective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs exact ha3.2 lemma joinLift_bijective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} - {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Bijective (@joinLift _ _ φsΛ φsucΛ) := by - apply And.intro - · exact joinLift_injective - · exact joinLift_surjective + {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Bijective (@joinLift _ _ φsΛ φsucΛ) := + ⟨joinLift_injective, joinLift_surjective⟩ lemma prod_join {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (f : (join φsΛ φsucΛ).1 → M) [CommMonoid M]: ∏ (a : (join φsΛ φsucΛ).1), f a = (∏ (a : φsΛ.1), f (joinLiftLeft a)) * ∏ (a : φsucΛ.1), f (joinLiftRight a) := by - let e1 := Equiv.ofBijective (@joinLift _ _ φsΛ φsucΛ) joinLift_bijective - rw [← e1.prod_comp] + rw [← (Equiv.ofBijective (@joinLift _ _ φsΛ φsucΛ) joinLift_bijective).prod_comp] simp only [Fintype.prod_sum_type, Finset.univ_eq_attach] rfl @@ -193,12 +176,8 @@ lemma joinLiftLeft_or_joinLiftRight_of_mem_join {φs : List 𝓕.FieldOp} simp only [join, Finset.le_eq_subset, Finset.mem_union, Finset.mem_map, RelEmbedding.coe_toEmbedding] at ha rcases ha with ha | ⟨a, ha, rfl⟩ - · left - use ⟨a, ha⟩ - rfl - · right - use ⟨a, ha⟩ - rfl + · exact Or.inl ⟨⟨a, ha⟩, rfl⟩ + · exact Or.inr ⟨⟨a, ha⟩, rfl⟩ @[simp] lemma join_fstFieldOfContract_joinLiftRight {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) @@ -252,15 +231,10 @@ lemma mem_join_right_iff {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs. simp only [h1', false_or] apply Iff.intro · intro h - use a - simp only [h, true_and] - rw [Finset.mapEmbedding_apply] - · intro h - obtain ⟨a, ha, h2⟩ := h - rw [Finset.mapEmbedding_apply] at h2 - simp only [Finset.map_inj] at h2 - subst h2 - exact ha + exact ⟨a, h, Finset.mapEmbedding_apply⟩ + · rintro ⟨a, ha, h2⟩ + rw [Finset.mapEmbedding_apply, Finset.map_inj] at h2 + exact h2 ▸ ha lemma join_card {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : @@ -273,11 +247,10 @@ lemma join_card {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding, not_exists, not_and] intro x hx by_contra hn - have hdis : Disjoint (Finset.map uncontractedListEmd x) a := by - exact uncontractedListEmd_finset_disjoint_left x a ha + have hdis : Disjoint (Finset.map uncontractedListEmd x) a := + uncontractedListEmd_finset_disjoint_left x a ha rw [Finset.mapEmbedding_apply] at hn rw [hn] at hdis - simp only [disjoint_self, Finset.bot_eq_empty] at hdis have hcard := φsΛ.2.1 a ha simp_all @@ -299,16 +272,12 @@ lemma empty_join {φs : List 𝓕.FieldOp} (φsΛ : WickContraction [empty (n := rw [Finset.mapEmbedding_apply] rw [Finset.map_map] apply Set.mem_of_eq_of_mem _ ha - trans Finset.map (Equiv.refl _).toEmbedding a - rfl - simp + exact Finset.map_refl · intro h use Finset.map (finCongr (by simp)).toEmbedding a simp only [h, true_and] - trans Finset.map (Equiv.refl _).toEmbedding a rw [Finset.mapEmbedding_apply, Finset.map_map] - rfl - simp + exact Finset.map_refl @[simp] lemma join_empty {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) : @@ -323,9 +292,7 @@ lemma join_timeContract {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.l simp only [timeContract, List.get_eq_getElem] rw [prod_join] congr 1 - congr - funext a - simp + exact Finset.prod_congr rfl fun a _ => by simp lemma join_staticContract {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) : @@ -333,9 +300,7 @@ lemma join_staticContract {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs simp only [staticContract, List.get_eq_getElem] rw [prod_join] congr 1 - congr - funext a - simp + exact Finset.prod_congr rfl fun a _ => by simp lemma mem_join_uncontracted_of_mem_right_uncontracted {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) @@ -376,10 +341,8 @@ lemma exists_mem_right_uncontracted_of_mem_join_uncontracted {φs : List 𝓕.Fi ∃ a, uncontractedListEmd a = i ∧ a ∈ φsucΛ.uncontracted := by have hi' := exists_mem_left_uncontracted_of_mem_join_uncontracted _ _ i hi obtain ⟨j, rfl⟩ := uncontractedListEmd_surjective_mem_uncontracted i hi' - use j - simp only [true_and] - rw [mem_uncontracted_iff_not_contracted] at hi - rw [mem_uncontracted_iff_not_contracted] + refine ⟨j, rfl, ?_⟩ + rw [mem_uncontracted_iff_not_contracted] at hi ⊢ intro p hp have hip := hi (p.map uncontractedListEmd) (by simp only [join, Finset.le_eq_subset, Finset.mem_union, Finset.mem_map, @@ -439,8 +402,7 @@ lemma join_uncontractedListEmb {φs : List 𝓕.FieldOp} (φsΛ : WickContractio φsucΛ.uncontractedListEmd).trans φsΛ.uncontractedListEmd := by refine Function.Embedding.ext_iff.mpr (congrFun ?_) change uncontractedListEmd.toFun = _ - rw [uncontractedListEmd_toFun_eq_get] - rw [join_uncontractedList_get] + rw [uncontractedListEmd_toFun_eq_get, join_uncontractedList_get] rfl set_option backward.isDefEq.respectTransparency false in @@ -506,8 +468,7 @@ lemma join_getDual?_apply_uncontractedListEmb_eq_none_iff {φs : List 𝓕.Field obtain ⟨a, ha', ha⟩ := exists_mem_right_uncontracted_of_mem_join_uncontracted _ _ (uncontractedListEmd i) h simp only [EmbeddingLike.apply_eq_iff_eq] at ha' - subst ha' - exact ha + exact ha' ▸ ha · intro h exact mem_join_uncontracted_of_mem_right_uncontracted φsΛ φsucΛ i h @@ -543,15 +504,11 @@ lemma join_getDual?_apply_uncontractedListEmb {φs : List 𝓕.FieldOp} Option.map uncontractedListEmd (φsucΛ.getDual? i) := by by_cases h : (φsucΛ.getDual? i).isSome · rw [join_getDual?_apply_uncontractedListEmb_some] - have h1 : (φsucΛ.getDual? i) = (φsucΛ.getDual? i).get (by simpa using h) := - Eq.symm (Option.some_get h) - conv_rhs => rw [h1] + conv_rhs => rw [← Option.some_get h] simp only [Option.map_some] exact (join_getDual?_apply_uncontractedListEmb_isSome_iff φsΛ φsucΛ i).mpr h · simp only [Bool.not_eq_true, Option.isSome_eq_false_iff, Option.isNone_iff_eq_none] at h - rw [h] - simp only [Option.map_none, join_getDual?_apply_uncontractedListEmb_eq_none_iff] - exact h + simp [h, join_getDual?_apply_uncontractedListEmb_eq_none_iff] /-! @@ -581,9 +538,7 @@ lemma join_sub_quot (S : Finset (Finset (Fin φs.length))) (ha : S ⊆ φsΛ.1) · simp [h1] · right obtain ⟨a, rfl, ha⟩ := h1 - use a - simp only [ha, true_and] - rw [Finset.mapEmbedding_apply] + exact ⟨a, ha, Finset.mapEmbedding_apply⟩ lemma subContraction_card_plus_quotContraction_card_eq (S : Finset (Finset (Fin φs.length))) (ha : S ⊆ φsΛ.1) : @@ -615,9 +570,8 @@ lemma join_singleton_getDual?_right {φs : List 𝓕.FieldOp} lemma exists_contraction_pair_of_card_ge_zero {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h : 0 < φsΛ.1.card) : - ∃ a, a ∈ φsΛ.1 := by - simp_all only [Finset.card_pos] - exact h + ∃ a, a ∈ φsΛ.1 := + Finset.card_pos.mp h set_option backward.isDefEq.respectTransparency false in set_option maxHeartbeats 400000 in diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean index c819bae03..7bc80c2f4 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean @@ -37,36 +37,20 @@ lemma stat_ofFinset_eq_one_of_gradingCompliant (φs : List 𝓕.FieldOp) (hnon : ∀ i, φsΛ.getDual? i = none → i ∉ a) (hsom : ∀ i, (h : (φsΛ.getDual? i).isSome) → i ∈ a → (φsΛ.getDual? i).get h ∈ a) : (𝓕 |>ₛ ⟨φs.get, a⟩) = 1 := by - rw [ofFinset_eq_prod] - let e2 : Fin φs.length ≃ {x // (φsΛ.getDual? x).isSome} ⊕ {x // ¬ (φsΛ.getDual? x).isSome} := by - exact (Equiv.sumCompl fun a => (φsΛ.getDual? a).isSome = true).symm - rw [← e2.symm.prod_comp] + rw [ofFinset_eq_prod, ← (Equiv.sumCompl fun a => (φsΛ.getDual? a).isSome = true).prod_comp] simp only [Fin.getElem_fin, Fintype.prod_sum_type] conv_lhs => enter [2, 2, x] - simp only [Equiv.symm_symm, Equiv.sumCompl_apply_inl, Equiv.sumCompl_apply_inr, e2] - rw [if_neg (hnon x.1 (by simpa using x.2))] - simp only [Equiv.symm_symm, Equiv.sumCompl_apply_inl, Finset.prod_const_one, mul_one, e2] - rw [← φsΛ.sigmaContractedEquiv.prod_comp] - rw [Fintype.prod_sigma] - apply Fintype.prod_eq_one _ - intro x + rw [Equiv.sumCompl_apply_inr, if_neg (hnon x.1 (by simpa using x.2))] + simp only [Equiv.sumCompl_apply_inl, Finset.prod_const_one, mul_one] + rw [← φsΛ.sigmaContractedEquiv.prod_comp, Fintype.prod_sigma] + refine Fintype.prod_eq_one _ fun x => ?_ rw [prod_finset_eq_mul_fst_snd] simp only [sigmaContractedEquiv, Equiv.coe_fn_mk, mul_ite, ite_mul, one_mul, mul_one] - split - · split - rw [hg x] - simp only [mul_self] - rename_i h1 h2 - have hsom' := hsom (φsΛ.sndFieldOfContract x) (by simp) h1 - simp only [sndFieldOfContract_getDual?, Option.get_some] at hsom' - exact False.elim (h2 hsom') - · split - rename_i h1 h2 - have hsom' := hsom (φsΛ.fstFieldOfContract x) (by simp) h2 - simp only [fstFieldOfContract_getDual?, Option.get_some] at hsom' - exact False.elim (h1 hsom') - rfl + have h1 := hsom (φsΛ.fstFieldOfContract x) (by simp) + have h2 := hsom (φsΛ.sndFieldOfContract x) (by simp) + simp only [fstFieldOfContract_getDual?, sndFieldOfContract_getDual?, Option.get_some] at h1 h2 + split <;> split <;> simp_all [hg x] lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (i : Fin φs.length.succ) (i1 i2 : Fin φs.length) @@ -85,125 +69,35 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie ext k rcases insert_fin_eq_self φ i k with hk | hk · subst hk - have h1 : Fin.cast (insertIdx_length_fin φ φs i).symm i ∈ - (if i.succAbove i1 < i ∧ i < i.succAbove i2 ∧ (i1 < j) then - Insert.insert (finCongr (insertIdx_length_fin φ φs i).symm i) - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2)) - else - if i1 < j ∧ j < i2 ∧ ¬ i.succAbove i1 < i then - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2)).erase - (finCongr (insertIdx_length_fin φ φs i).symm (i.succAbove j)) - else - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2))) ↔ - i.succAbove i1 < i ∧ i < i.succAbove i2 ∧ (i1 < j) := by - split - simp_all only [Nat.succ_eq_add_one, finCongr_apply, Finset.mem_insert, - self_not_mem_insertAndContractLiftFinset, or_false, and_self] - rename_i h - simp only [Nat.succ_eq_add_one, not_lt, finCongr_apply, h, iff_false] - split - simp only [Finset.mem_erase, ne_eq, self_not_mem_insertAndContractLiftFinset, and_false, - not_false_eq_true] - simp - rw [h1] simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, Finset.mem_univ, insertAndContract_some_getDual?_self_eq, reduceCtorEq, Option.isSome_some, Option.get_some, - forall_const, false_or, true_and] - rw [Fin.lt_def, Fin.lt_def, Fin.lt_def, Fin.lt_def] - simp only [Fin.val_cast, Fin.val_fin_lt, and_congr_right_iff] - intro h1 h2 - exact Fin.succAbove_lt_succAbove_iff + forall_const, false_or, true_and, Fin.cast_lt_cast, Fin.succAbove_lt_succAbove_iff] + split + · simp_all + · rename_i h + simp only [h, false_iff] + split <;> simp · obtain ⟨k, hk⟩ := hk subst hk by_cases hkj : k = j.1 · subst hkj - conv_lhs=> simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, + have hj : φsΛ.getDual? ↑j = none := (φsΛ.getDual?_eq_none_iff_mem_uncontracted ↑j).mpr j.2 + simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, Finset.mem_univ, insertAndContract_some_getDual?_some_eq, reduceCtorEq, Option.isSome_some, - Option.get_some, forall_const, false_or, true_and, not_lt] - rw [Fin.lt_def, Fin.lt_def] - simp only [Fin.val_cast, Fin.val_fin_lt, Nat.succ_eq_add_one, finCongr_apply, not_lt] - conv_lhs => - enter [2, 2] - rw [Fin.lt_def] - simp only [Fin.val_cast, Fin.val_fin_lt] + Option.get_some, forall_const, false_or, true_and, Fin.cast_lt_cast, + Fin.succAbove_lt_succAbove_iff] split - · rename_i h - simp_all only [and_true, Finset.mem_insert] - rw [succAbove_mem_insertAndContractLiftFinset] - simp only [Fin.ext_iff, Fin.val_cast] - have h1 : ¬ (i.succAbove ↑j) = i := Fin.succAbove_ne i ↑j - simp only [Fin.val_eq_val, h1, signFinset, Finset.mem_filter, Finset.mem_univ, true_and, - false_or] - rw [Fin.succAbove_lt_succAbove_iff, Fin.succAbove_lt_succAbove_iff] - simp only [and_congr_right_iff, iff_self_and] - intro h1 h2 - apply Or.inl - have hj:= j.2 - simpa [uncontracted, -SetLike.coe_mem] using hj - · rename_i h - simp only [not_and, not_lt] at h - rw [Fin.succAbove_lt_succAbove_iff, Fin.succAbove_lt_succAbove_iff] - split - · rename_i h1 - simp only [Finset.mem_erase, ne_eq, not_true_eq_false, false_and, iff_false, not_and, - not_lt] - intro h1 h2 - omega - · rename_i h1 - rw [succAbove_mem_insertAndContractLiftFinset] - simp only [signFinset, Finset.mem_filter, Finset.mem_univ, true_and, and_congr_right_iff] - intro h1 h2 - have hj:= j.2 - simp only [uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hj - simp only [hj, Option.isSome_none, Bool.false_eq_true, IsEmpty.forall_iff, or_self, - iff_true, gt_iff_lt] - omega - · have h1 : Fin.cast (insertIdx_length_fin φ φs i).symm (i.succAbove k) ∈ - (if i.succAbove i1 < i ∧ i < i.succAbove i2 ∧ (i1 < j) then - Insert.insert (finCongr (insertIdx_length_fin φ φs i).symm i) - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2)) - else - if i1 < j ∧ j < i2 ∧ ¬ i.succAbove i1 < i then - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2)).erase - (finCongr (insertIdx_length_fin φ φs i).symm (i.succAbove j)) - else - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2))) ↔ - Fin.cast (insertIdx_length_fin φ φs i).symm (i.succAbove k) ∈ - (insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2)) := by - split - · simp only [Nat.succ_eq_add_one, finCongr_apply, Finset.mem_insert, or_iff_right_iff_imp] - intro h - simp only [Fin.ext_iff, Fin.val_cast] at h - simp only [Fin.val_eq_val] at h - have hn : ¬ i.succAbove k = i := Fin.succAbove_ne i k - exact False.elim (hn h) - · split - simp only [Nat.succ_eq_add_one, finCongr_apply, Finset.mem_erase, ne_eq, - and_iff_right_iff_imp] - intro h - simp only [Fin.ext_iff, Fin.val_cast] - simp only [Fin.val_eq_val] - rw [Function.Injective.eq_iff] - exact hkj - exact Fin.succAbove_right_injective - · simp - rw [h1] - rw [succAbove_mem_insertAndContractLiftFinset] - simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, - Finset.mem_univ, true_and] - rw [Fin.lt_def, Fin.lt_def, Fin.lt_def, Fin.lt_def] - simp only [Fin.val_cast, Fin.val_fin_lt] - rw [Fin.succAbove_lt_succAbove_iff, Fin.succAbove_lt_succAbove_iff] - simp only [and_congr_right_iff] - intro h1 h2 - simp only [ne_eq, hkj, not_false_eq_true, insertAndContract_some_succAbove_getDual?_eq_option, - Nat.succ_eq_add_one, Option.map_eq_none_iff, Option.isSome_map] - conv_lhs => - rhs - enter [h] - rw [Fin.lt_def] - simp only [Fin.val_cast, Option.get_map, Function.comp_apply, Fin.val_fin_lt] - rw [Fin.succAbove_lt_succAbove_iff] + · simp_all [succAbove_mem_insertAndContractLiftFinset, Fin.cast_inj, Fin.succAbove_ne] + · split <;> simp_all [succAbove_mem_insertAndContractLiftFinset] + · simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, + Finset.mem_univ, true_and, ne_eq, hkj, not_false_eq_true, + insertAndContract_some_succAbove_getDual?_eq_option, Option.map_eq_none_iff, + Option.isSome_map, Option.get_map, Function.comp_apply, Fin.cast_lt_cast, + Fin.succAbove_lt_succAbove_iff] + split + · simp [Fin.cast_inj, Fin.succAbove_ne, succAbove_mem_insertAndContractLiftFinset] + · split <;> simp [Fin.cast_inj, Fin.succAbove_right_injective.eq_iff, hkj, + succAbove_mem_insertAndContractLiftFinset] /-- Given a Wick contraction `φsΛ` the sign defined in the following way, @@ -250,8 +144,8 @@ def signInsertSome (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickCo lemma sign_insert_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (i : Fin φs.length.succ) (j : φsΛ.uncontracted) : (φsΛ ↩Λ φ i (some j)).sign = (φsΛ.signInsertSome φ φs i j) * φsΛ.sign := by - rw [sign, signInsertSome, signInsertSomeProd, sign, mul_assoc, ← Finset.prod_mul_distrib] - rw [insertAndContract_some_prod_contractions] + rw [sign, signInsertSome, signInsertSomeProd, sign, mul_assoc, ← Finset.prod_mul_distrib, + insertAndContract_some_prod_contractions] congr funext a simp only [Nat.succ_eq_add_one, insertAndContract_sndFieldOfContract, @@ -259,32 +153,21 @@ lemma sign_insert_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : Wi insertAndContract_fstFieldOfContract, not_lt, ite_mul, one_mul] erw [signFinset_insertAndContract_some] split - · rename_i h - simp only [Nat.succ_eq_add_one, finCongr_apply] - rw [ofFinset_insert] - simp only [Fin.getElem_fin, Fin.val_cast, List.getElem_insertIdx_self, map_mul] - rw [stat_ofFinset_of_insertAndContractLiftFinset] - simp only [exchangeSign_symm] - simp - · rename_i h - split - · rename_i h1 + · simp only [Nat.succ_eq_add_one, finCongr_apply] + rw [ofFinset_insert _ _ _ _ (self_not_mem_insertAndContractLiftFinset φ i _), + stat_ofFinset_of_insertAndContractLiftFinset] + simp [List.getElem_insertIdx_self, exchangeSign_symm] + · split + · rename_i h h1 simp only [Nat.succ_eq_add_one, finCongr_apply, h1, true_and] - rw [if_pos] - rw [ofFinset_erase] - simp only [Fin.getElem_fin, Fin.val_cast, insertIdx_getElem_fin, map_mul] - rw [stat_ofFinset_of_insertAndContractLiftFinset] - simp only [exchangeSign_symm] + rw [if_pos, ofFinset_erase, stat_ofFinset_of_insertAndContractLiftFinset] + simp only [Fin.getElem_fin, Fin.val_cast, insertIdx_getElem_fin, map_mul, + exchangeSign_symm] · rw [succAbove_mem_insertAndContractLiftFinset] simp only [signFinset, Finset.mem_filter, Finset.mem_univ, true_and] - simp_all only [Nat.succ_eq_add_one, and_true, false_and, not_false_eq_true, not_lt, - true_and] - apply Or.inl - simpa [uncontracted, -SetLike.coe_mem] using j.2 + exact ⟨h1.1, h1.2.1, Or.inl ((φsΛ.getDual?_eq_none_iff_mem_uncontracted ↑j).mpr j.2)⟩ · simp_all - · rename_i h1 - rw [if_neg] - rw [stat_ofFinset_of_insertAndContractLiftFinset] + · rw [if_neg, stat_ofFinset_of_insertAndContractLiftFinset] simp_all lemma signInsertSomeProd_eq_one_if (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) @@ -303,22 +186,10 @@ lemma signInsertSomeProd_eq_one_if (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) congr funext a split - · rename_i h - simp only [Fin.getElem_fin, h, Nat.succ_eq_add_one, and_self, - not_true_eq_false, and_false, or_false, ↓reduceIte] - · rename_i h - split - · rename_i h1 - simp only [Fin.getElem_fin, h1, Nat.succ_eq_add_one, false_and, - not_false_eq_true, and_self, or_true, ↓reduceIte] - congr 1 - exact congrArg (⇑exchangeSign) (id (Eq.symm hφj)) - · rename_i h1 - simp only [Nat.succ_eq_add_one, not_lt, Fin.getElem_fin] - rw [if_neg] - simp_all only [Fin.getElem_fin, Nat.succ_eq_add_one, not_and, not_lt, not_le, not_or, - implies_true, and_true] - omega + · rw [if_pos (by omega)] + · split + · rw [hφj, if_pos (by omega)] + · rw [if_neg (by omega)] lemma signInsertSomeProd_eq_prod_prod (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) @@ -333,25 +204,17 @@ lemma signInsertSomeProd_eq_prod_prod (φ : 𝓕.FieldOp) (φs : List 𝓕.Field 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs[x.1]) else 1 := by - rw [signInsertSomeProd_eq_one_if] + rw [signInsertSomeProd_eq_one_if (hφj := hφj)] congr funext a rw [prod_finset_eq_mul_fst_snd] nth_rewrite 3 [if_neg] · simp only [Nat.succ_eq_add_one, not_lt, Fin.getElem_fin, - fstFieldOfContract_getDual?, Option.get_some, mul_one] - congr 1 - rw [hg a] - · simp only [Nat.succ_eq_add_one, sndFieldOfContract_getDual?, Option.get_some, not_lt, not_and, - not_or, not_le] - intro h1 + fstFieldOfContract_getDual?, Option.get_some, mul_one, hg a] + · simp only [sndFieldOfContract_getDual?, Option.get_some] have ha := fstFieldOfContract_lt_sndFieldOfContract φsΛ a - apply And.intro - · intro hi - have hx := (Fin.succAbove_lt_succAbove_iff (p := i)).mpr ha - omega - · omega - simp [hφj] + have hx := (Fin.succAbove_lt_succAbove_iff (p := i)).mpr ha + omega lemma signInsertSomeProd_eq_prod_fin (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) @@ -365,26 +228,11 @@ lemma signInsertSomeProd_eq_prod_fin (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldO then 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs[x.1]) else 1 else 1 := by - rw [signInsertSomeProd_eq_prod_prod] - rw [Finset.prod_sigma'] + rw [signInsertSomeProd_eq_prod_prod (hφj := hφj) (hg := hg), Finset.prod_sigma'] erw [← φsΛ.sigmaContractedEquiv.symm.prod_comp] - let e2 : Fin φs.length ≃ {x // (φsΛ.getDual? x).isSome} ⊕ {x // ¬ (φsΛ.getDual? x).isSome} := by - exact (Equiv.sumCompl fun a => (φsΛ.getDual? a).isSome = true).symm - rw [← e2.symm.prod_comp] - simp only [Fin.getElem_fin, Fintype.prod_sum_type] - conv_rhs => - rhs - enter [2, a] - rw [dif_neg (by simpa [e2] using a.2)] - conv_rhs => - lhs - enter [2, a] - rw [dif_pos (by simpa [e2] using a.2)] - simp only [Nat.succ_eq_add_one, not_lt, Equiv.symm_symm, Equiv.sumCompl_apply_inl, - Finset.prod_const_one, mul_one, e2] + rw [Fintype.prod_dite] + simp only [Finset.prod_const_one, mul_one] rfl - simp only [hφj, Fin.getElem_fin] - exact hg lemma signInsertSomeProd_eq_finset (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) @@ -395,24 +243,14 @@ lemma signInsertSomeProd_eq_finset (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) ∀ (h : (φsΛ.getDual? x).isSome), x < j ∧ (i.succAbove x < i ∧ i < i.succAbove ((φsΛ.getDual? x).get h) ∨ j < ((φsΛ.getDual? x).get h) ∧ ¬ i.succAbove x < i)))⟩) := by - rw [signInsertSomeProd_eq_prod_fin] - rw [ofFinset_eq_prod] - rw [map_prod] + rw [signInsertSomeProd_eq_prod_fin (hφj := hφj) (hg := hg), ofFinset_eq_prod, map_prod] congr funext x - split - · rename_i h - simp only [Nat.succ_eq_add_one, not_lt, Finset.mem_filter, Finset.mem_univ, + split <;> rename_i h + · simp only [Nat.succ_eq_add_one, not_lt, Finset.mem_filter, Finset.mem_univ, h, forall_true_left, true_and, Fin.getElem_fin] - split - · rename_i h1 - simp - · rename_i h1 - simp - · rename_i h - simp [h] - simp only [hφj, Fin.getElem_fin] - exact hg + split <;> simp + · simp [h] lemma signInsertSomeCoef_if (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (i : Fin φs.length.succ) (j : φsΛ.uncontracted) (hφj : (𝓕 |>ₛ φ) = (𝓕 |>ₛ φs[j.1])) : @@ -426,12 +264,9 @@ lemma signInsertSomeCoef_if (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ signFinset (φsΛ ↩Λ φ i (some j)) (finCongr (insertIdx_length_fin φ φs i).symm (i.succAbove j)) (finCongr (insertIdx_length_fin φ φs i).symm i)⟩) := by - simp only [signInsertSomeCoef, Nat.succ_eq_add_one, - insertAndContract_sndFieldOfContract_some_incl, finCongr_apply, Fin.getElem_fin, + simp only [signInsertSomeCoef, insertAndContract_sndFieldOfContract_some_incl, insertAndContract_fstFieldOfContract_some_incl] - split - · simp [hφj] - · simp [hφj] + split <;> simp [hφj] lemma stat_signFinset_insert_some_self_fst (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) @@ -442,73 +277,28 @@ lemma stat_signFinset_insert_some_self_fst 𝓕 |>ₛ ⟨φs.get, (Finset.univ.filter (fun x => i < i.succAbove x ∧ x < j ∧ ((φsΛ.getDual? x = none) ∨ ∀ (h : (φsΛ.getDual? x).isSome), i < i.succAbove ((φsΛ.getDual? x).get h))))⟩ := by - rw [get_eq_insertIdx_succAbove φ _ i] - rw [ofFinset_finset_map] - swap - refine - (Equiv.comp_injective i.succAbove (finCongr (Eq.symm (insertIdx_length_fin φ φs i)))).mpr ?hi.a - exact Fin.succAbove_right_injective + rw [get_eq_insertIdx_succAbove φ _ i, ofFinset_finset_map _ _ + ((Equiv.comp_injective _ _).mpr Fin.succAbove_right_injective)] congr ext x simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_map, Function.Embedding.coeFn_mk, Function.comp_apply] rcases insert_fin_eq_self φ i x with hx | hx · subst hx - simp only [Nat.succ_eq_add_one, lt_self_iff_false, insertAndContract_some_getDual?_self_eq, - reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, false_or, and_self, - false_and, false_iff, not_exists, not_and, and_imp] - intro x hi hx h - simp only [Fin.ext_iff, Fin.val_cast] - simp only [Fin.val_eq_val] - exact Fin.succAbove_ne i x + simp [Fin.cast_inj, Fin.succAbove_ne] · obtain ⟨x, hx⟩ := hx subst hx by_cases h : x = j.1 · subst h simp only [Nat.succ_eq_add_one, lt_self_iff_false, insertAndContract_some_getDual?_some_eq, reduceCtorEq, Option.isSome_some, Option.get_some, imp_false, not_true_eq_false, or_self, - and_self, and_false, false_iff, not_exists, not_and, and_imp] - intro x hi hx h0 - simp only [Fin.ext_iff, Fin.val_cast] - simp only [Fin.val_eq_val] - rw [Function.Injective.eq_iff] + and_self, and_false, false_iff, not_exists, not_and, and_imp, Fin.cast_inj, + Fin.succAbove_right_injective.eq_iff] omega - exact Fin.succAbove_right_injective · simp only [Nat.succ_eq_add_one, ne_eq, h, not_false_eq_true, insertAndContract_some_succAbove_getDual?_eq_option, Option.map_eq_none_iff, - Option.isSome_map] - rw [Fin.lt_def, Fin.lt_def] - simp only [Fin.val_cast, Fin.val_fin_lt] - apply Iff.intro - · intro h - use x - simp only [h, true_and, and_true] - simp only [Option.get_map, Function.comp_apply] at h - apply And.intro (Fin.succAbove_lt_succAbove_iff.mp h.2.1) - have h2 := h.2.2 - rcases h2 with h2 | h2 - · simp [h2] - · apply Or.inr - intro h - have h2 := h2 h - simpa using h2 - · intro h - obtain ⟨y, hy1, hy2⟩ := h - simp only [Fin.ext_iff, Fin.val_cast] at hy2 - simp only [Fin.val_eq_val] at hy2 - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at hy2 - subst hy2 - simp only [hy1, true_and] - apply And.intro - · rw [@Fin.succAbove_lt_succAbove_iff] - omega - · have hy2 := hy1.2.2 - rcases hy2 with hy2 | hy2 - · simp [hy2] - · apply Or.inr - intro h - have hy2 := hy2 h - simpa [Option.get_map] using hy2 + Option.isSome_map, Option.get_map, Function.comp_apply, Fin.cast_lt_cast, Fin.cast_inj, + Fin.succAbove_right_injective.eq_iff, exists_eq_right, Fin.succAbove_lt_succAbove_iff] lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (i : Fin φs.length.succ) (j : φsΛ.uncontracted) : @@ -519,76 +309,28 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕. 𝓕 |>ₛ ⟨φs.get, (Finset.univ.filter (fun x => j < x ∧ i.succAbove x < i ∧ ((φsΛ.getDual? x = none) ∨ ∀ (h : (φsΛ.getDual? x).isSome), j < ((φsΛ.getDual? x).get h))))⟩ := by - rw [get_eq_insertIdx_succAbove φ _ i, ofFinset_finset_map] - swap - refine - (Equiv.comp_injective i.succAbove (finCongr (Eq.symm (insertIdx_length_fin φ φs i)))).mpr ?hi.a - exact Fin.succAbove_right_injective + rw [get_eq_insertIdx_succAbove φ _ i, ofFinset_finset_map _ _ + ((Equiv.comp_injective _ _).mpr Fin.succAbove_right_injective)] congr ext x simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_map, Function.Embedding.coeFn_mk, Function.comp_apply] rcases insert_fin_eq_self φ i x with hx | hx · subst hx - simp only [Nat.succ_eq_add_one, lt_self_iff_false, insertAndContract_some_getDual?_self_eq, - reduceCtorEq, Option.isSome_some, Option.get_some, imp_false, not_true_eq_false, or_self, - and_self, and_false, false_iff, not_exists, not_and, and_imp] - intro x hi hx h - simp only [Fin.ext_iff, Fin.val_cast] - simp only [Fin.val_eq_val] - exact Fin.succAbove_ne i x + simp [Fin.cast_inj, Fin.succAbove_ne] · obtain ⟨x, hx⟩ := hx subst hx by_cases h : x = j.1 · subst h simp only [Nat.succ_eq_add_one, lt_self_iff_false, insertAndContract_some_getDual?_some_eq, reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, false_or, and_self, - false_and, false_iff, not_exists, not_and, and_imp] - intro x hi hx h0 - simp only [Fin.ext_iff, Fin.val_cast] - simp only [Fin.val_eq_val] - rw [Function.Injective.eq_iff] + false_and, false_iff, not_exists, not_and, and_imp, Fin.cast_inj, + Fin.succAbove_right_injective.eq_iff] omega - exact Fin.succAbove_right_injective · simp only [Nat.succ_eq_add_one, ne_eq, h, not_false_eq_true, insertAndContract_some_succAbove_getDual?_eq_option, Option.map_eq_none_iff, - Option.isSome_map] - rw [Fin.lt_def, Fin.lt_def] - simp only [Fin.val_cast, Fin.val_fin_lt] - apply Iff.intro - · intro h - use x - simp only [h, true_and, and_true] - simp only [Option.get_map, Function.comp_apply] at h - apply And.intro (Fin.succAbove_lt_succAbove_iff.mp h.1) - have h2 := h.2.2 - rcases h2 with h2 | h2 - · simp [h2] - · apply Or.inr - intro h - have h2 := h2 h - rw [Fin.lt_def] at h2 - simp only [Fin.val_cast, Fin.val_fin_lt] at h2 - exact Fin.succAbove_lt_succAbove_iff.mp h2 - · intro h - obtain ⟨y, hy1, hy2⟩ := h - simp only [Fin.ext_iff, Fin.val_cast] at hy2 - simp only [Fin.val_eq_val] at hy2 - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at hy2 - subst hy2 - simp only [hy1, true_and] - apply And.intro - · rw [@Fin.succAbove_lt_succAbove_iff] - omega - · have hy2 := hy1.2.2 - rcases hy2 with hy2 | hy2 - · simp [hy2] - · apply Or.inr - intro h - have hy2 := hy2 h - simp only [Fin.lt_def, Fin.val_cast, gt_iff_lt] - simp only [Option.get_map, Function.comp_apply, Fin.val_cast, Fin.val_fin_lt] - exact Fin.succAbove_lt_succAbove_iff.mpr hy2 + Option.isSome_map, Option.get_map, Function.comp_apply, Fin.cast_lt_cast, Fin.cast_inj, + Fin.succAbove_right_injective.eq_iff, exists_eq_right, Fin.succAbove_lt_succAbove_iff] lemma signInsertSomeCoef_eq_finset (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (i : Fin φs.length.succ) (j : φsΛ.uncontracted) @@ -647,91 +389,32 @@ lemma signInsertSome_mul_filter_contracted_of_lt (φ : 𝓕.FieldOp) (φs : List rw [Finset.disjoint_filter] intro j _ h simp only [Nat.succ_eq_add_one, not_lt, not_and, not_forall, not_or, not_le] - intro h1 - use h1 - omega + exact fun h1 => ⟨h1, by omega⟩ rw [ofFinset_union, ← mul_eq_one_iff, ofFinset_union] simp only [Nat.succ_eq_add_one, not_lt] apply stat_ofFinset_eq_one_of_gradingCompliant _ _ _ hg.1 · /- The `c.getDual? i = none` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/ intro j hn + have h1 := Fin.succAbove_le_succAbove_iff (p := i) (i := j) (j := k.1) + have h2 := Fin.ne_succAbove i j simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ, hn, Option.isSome_none, Bool.false_eq_true, IsEmpty.forall_iff, or_self, and_true, or_false, true_and, and_self, Finset.mem_inter, not_and, not_lt, Classical.not_imp, not_le, and_imp] - intro h - rcases h with h | h - · simp only [h, or_true, isEmpty_Prop, not_le, IsEmpty.forall_iff, and_self] - · simp only [h, true_and] - refine And.intro ?_ (And.intro ?_ h.2) - · by_contra hkj - simp only [not_lt] at hkj - have h2 := h.2 hkj - apply Fin.ne_succAbove i j - have hij : i.succAbove j ≤ i.succAbove k.1 := Fin.succAbove_le_succAbove_iff.mpr hkj - omega - · have h1' := h.1 - rcases h1' with h1' | h1' - · have hl := h.2 h1' - have hij : i.succAbove j ≤ i.succAbove k.1 := Fin.succAbove_le_succAbove_iff.mpr h1' - by_contra hn - apply Fin.ne_succAbove i j - omega - · exact h1' + omega · /- The `(c.getDual? i).isSome` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/ intro j hj have hn : ¬ φsΛ.getDual? j = none := Option.isSome_iff_ne_none.mp hj + have hkd := (φsΛ.getDual?_eq_none_iff_mem_uncontracted _).mpr k.2 + have hkneqj : ↑k ≠ j := fun h => by simp [h ▸ hkd] at hj + have hkneqdual : k.1 ≠ (φsΛ.getDual? j).get hj := fun h => by simp [h] at hkd + have h2' := Fin.ne_succAbove i ((φsΛ.getDual? j).get hj) + have m1 := Fin.succAbove_lt_succAbove_iff (p := i) (i := j) (j := k.1) + have m2 := Fin.succAbove_lt_succAbove_iff (p := i) (i := (φsΛ.getDual? j).get hj) (j := k.1) simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ, hn, hj, forall_true_left, false_or, true_and, and_false, false_and, Finset.mem_inter, not_false_eq_true, and_true, not_and, not_lt, getDual?_getDual?_get_get, reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, and_imp] - intro h1 h2 - have hijsucc' : i.succAbove ((φsΛ.getDual? j).get hj) ≠ i := Fin.succAbove_ne i _ - have hkneqj : ↑k ≠ j := by - by_contra hkj - have hk := k.prop - simp only [uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hk - simp_all - have hkneqgetdual : k.1 ≠ (φsΛ.getDual? j).get hj := by - by_contra hkj - have hk := k.prop - simp only [uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hk - simp_all - by_cases hik : ↑k < j - · have hn : ¬ j < ↑k := by omega - simp only [hik, true_and, hn, false_and, or_false, and_imp, and_true] at h1 h2 ⊢ - have hir : i.succAbove j < i := by - rcases h1 with h1 | h1 - · simp [h1] - · simp [h1] - simp only [hir, true_and, or_true, forall_const] at h1 h2 - have hnkdual : ¬ ↑k < (φsΛ.getDual? j).get hj := by - by_contra hn - have h2 := h2 hn - apply Fin.ne_succAbove i j - omega - simp only [hnkdual, IsEmpty.forall_iff, false_and, false_or, and_imp] at h2 ⊢ - have hnkdual : (φsΛ.getDual? j).get hj < ↑k := by omega - have hi : i.succAbove ((φsΛ.getDual? j).get hj) < i.succAbove k := by - rw [@Fin.succAbove_lt_succAbove_iff] - omega - omega - · have ht : j < ↑k := by omega - have ht' : i.succAbove j < i.succAbove k := by - rw [@Fin.succAbove_lt_succAbove_iff] - omega - simp only [hik, false_and, ht, true_and, false_or, and_false, or_false, and_imp] at h1 h2 ⊢ - by_cases hik : i.succAbove j < i - · simp_all only [Fin.getElem_fin, ne_eq, not_lt, true_and, or_true] - have hn : ¬ i ≤ i.succAbove j := by omega - simp_all only [and_false, or_false, imp_false, not_lt, Nat.succ_eq_add_one, not_le] - apply And.intro - · apply Or.inr - omega - · intro h1 h2 h3 - omega - · simp_all only [Fin.getElem_fin, ne_eq, not_lt, false_and, false_or, or_false, and_self, - or_true, imp_self] - omega + omega /-- The following two signs are equal for `i < i.succAbove k`. @@ -779,84 +462,27 @@ lemma signInsertSome_mul_filter_contracted_of_not_lt (φ : 𝓕.FieldOp) (φs : · /- The `c.getDual? i = none` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/ intro j hj have hijsucc : i.succAbove j ≠ i := Fin.succAbove_ne i j + have h1 := Fin.succAbove_lt_succAbove_iff (p := i) (i := j) (j := k.1) simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ, hj, Option.isSome_none, Bool.false_eq_true, IsEmpty.forall_iff, or_self, and_true, true_and, and_false, or_false, Finset.mem_inter, not_false_eq_true, and_self, not_and, not_lt, Classical.not_imp, not_le, and_imp] - intro h - have hij : i < i.succAbove j := by - rcases h with h | h - · exact h.1 - · rcases h.1 with h1 | h1 - · omega - · have hik : i.succAbove k.1 ≤ i.succAbove j := by - rw [Fin.succAbove_le_succAbove_iff] - omega - omega - simp only [hij, true_and] at h ⊢ omega · /- The `(c.getDual? i).isSome` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/ intro j hj have hn : ¬ φsΛ.getDual? j = none := Option.isSome_iff_ne_none.mp hj + have hkd := (φsΛ.getDual?_eq_none_iff_mem_uncontracted _).mpr k.2 + have hkneqj : ↑k ≠ j := fun h => by simp [h ▸ hkd] at hj have hijSuc : i.succAbove j ≠ i := Fin.succAbove_ne i j - have hkneqj : ↑k ≠ j := by - by_contra hkj - have hk := k.prop - simp only [uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hk - simp_all - have hkneqgetdual : k.1 ≠ (φsΛ.getDual? j).get hj := by - by_contra hkj - have hk := k.prop - simp only [uncontracted, Finset.mem_filter, Finset.mem_univ, true_and] at hk - simp_all + have hkneqdual : k.1 ≠ (φsΛ.getDual? j).get hj := fun h => by simp [h] at hkd + have h2' := Fin.ne_succAbove i ((φsΛ.getDual? j).get hj) + have m1 := Fin.succAbove_lt_succAbove_iff (p := i) (i := j) (j := k.1) + have m2 := Fin.succAbove_lt_succAbove_iff (p := i) (i := (φsΛ.getDual? j).get hj) (j := k.1) simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ, hn, hj, forall_true_left, false_or, true_and, Finset.mem_inter, not_and, not_or, not_lt, not_le, and_imp, and_false, false_and, not_false_eq_true, and_true, getDual?_getDual?_get_get, reduceCtorEq, Option.isSome_some, Option.get_some, forall_const] - by_cases hik : ↑k < j - · have hikn : ¬ j < k.1 := by omega - have hksucc : i.succAbove k.1 < i.succAbove j := by - rw [Fin.succAbove_lt_succAbove_iff] - omega - have hkn : i < i.succAbove j := by omega - have hl : ¬ i.succAbove j < i := by omega - simp only [hkn, hikn, false_and, and_false, hl, false_or, or_self, IsEmpty.forall_iff, - imp_false, not_lt, true_and, implies_true, and_true, forall_const, hik, - imp_forall_iff_forall] - · have hikn : j < k.1 := by omega - have hksucc : i.succAbove j < i.succAbove k.1 := Fin.succAbove_lt_succAbove_iff.mpr hikn - simp only [hikn, true_and, forall_const, hik, false_and, or_false, IsEmpty.forall_iff, - and_true] - by_cases hij: i < i.succAbove j - · simp only [hij, true_and, forall_const, and_true, imp_forall_iff_forall] - have hijn : ¬ i.succAbove j < i := by omega - simp only [hijn, false_and, false_or, IsEmpty.forall_iff, imp_false, not_lt, true_and, - or_false, and_imp] - have hijle : i ≤ i.succAbove j := by omega - simp only [hijle, and_true, implies_true, forall_const] - intro h1 h2 - apply And.intro - · rcases h1 with h1 | h1 - · apply Or.inl - omega - · apply Or.inl - have hi : i.succAbove k.1 < i.succAbove ((φsΛ.getDual? j).get hj) := - Fin.succAbove_lt_succAbove_iff.mpr h1 - apply And.intro - · apply Or.inr - apply And.intro - · omega - · omega - · omega - · intro h3 h4 - omega - · simp only [hij, false_and, false_or, IsEmpty.forall_iff, and_true, forall_const, and_false, - or_self, implies_true] - have hijn : i.succAbove j < i := by omega - have hijn' : ¬ i ≤ i.succAbove j := by omega - simp only [hijn, true_and, hijn', and_false, or_false, or_true, imp_false, not_lt, - forall_const] - exact fun h => lt_of_le_of_ne h (Fin.succAbove_ne i ((φsΛ.getDual? j).get hj)) + omega /-- For a list `φs = φ₀…φₙ` of `𝓕.FieldOp`, a Wick contraction `φsΛ` of `φs`, an element `φ` of @@ -876,12 +502,9 @@ lemma sign_insert_some_of_lt (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, φsΛ.uncontracted.filter (fun x => x ≤ ↑k)⟩) * 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, Finset.univ.filter (fun x => i.succAbove x < i)⟩) * φsΛ.sign := by - rw [sign_insert_some, - ← signInsertSome_mul_filter_contracted_of_lt φ φs φsΛ i k hk hg] - rw [← mul_assoc] + rw [sign_insert_some, ← signInsertSome_mul_filter_contracted_of_lt φ φs φsΛ i k hk hg] congr 1 - rw [mul_comm, ← mul_assoc] - simp + rw [mul_comm, mul_assoc, exchangeSign_mul_self, mul_one] /-- For a list `φs = φ₀…φₙ` of `𝓕.FieldOp`, a Wick contraction `φsΛ` of `φs`, an element `φ` of @@ -901,12 +524,9 @@ lemma sign_insert_some_of_not_lt (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, φsΛ.uncontracted.filter (fun x => x < ↑k)⟩) * 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, Finset.univ.filter (fun x => i.succAbove x < i)⟩) * φsΛ.sign := by - rw [sign_insert_some, - ← signInsertSome_mul_filter_contracted_of_not_lt φ φs φsΛ i k hk hg] - rw [← mul_assoc] + rw [sign_insert_some, ← signInsertSome_mul_filter_contracted_of_not_lt φ φs φsΛ i k hk hg] congr 1 - rw [mul_comm, ← mul_assoc] - simp + rw [mul_comm, mul_assoc, exchangeSign_mul_self, mul_one] /-- For a list `φs = φ₀…φₙ` of `𝓕.FieldOp`, a Wick contraction `φsΛ` of `φs`, an element `φ` of @@ -922,9 +542,6 @@ lemma sign_insert_some_zero (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (hn : GradingCompliant φs φsΛ ∧ (𝓕|>ₛφ) = 𝓕|>ₛφs[k.1]) : (φsΛ ↩Λ φ 0 k).sign = 𝓢(𝓕|>ₛφ, 𝓕 |>ₛ ⟨φs.get, (φsΛ.uncontracted.filter (fun x => x < ↑k))⟩) * φsΛ.sign := by - rw [sign_insert_some_of_not_lt] - · simp - · simp - · exact hn + simpa using sign_insert_some_of_not_lt φ φs φsΛ 0 k (by simp) hn end WickContraction diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/StaticContract.lean b/Physlib/QFT/PerturbationTheory/WickContraction/StaticContract.lean index c793cfc45..37017774b 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/StaticContract.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/StaticContract.lean @@ -46,9 +46,7 @@ lemma staticContract_insert_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (i : Fin φs.length.succ) : (φsΛ ↩Λ φ i none).staticContract = φsΛ.staticContract := by rw [staticContract, insertAndContract_none_prod_contractions] - congr - ext a - simp + simp [staticContract] /-- For a list `φs = φ₀…φₙ` of `𝓕.FieldOp`, a Wick contraction `φsΛ` of `φs`, an element `φ` of @@ -71,12 +69,8 @@ lemma staticContract_insert_some congr 1 · simp only [Nat.succ_eq_add_one, insertAndContract_fstFieldOfContract_some_incl, finCongr_apply, List.get_eq_getElem, insertAndContract_sndFieldOfContract_some_incl, Fin.getElem_fin] - split - · simp - · simp - · congr - ext a - simp + split <;> simp + · simp [staticContract] open FieldStatistic @@ -96,10 +90,6 @@ lemma staticContract_insert_some_of_lt List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem, Algebra.smul_mul_assoc, uncontractedListGet] · simp only [hik, ↓reduceIte, MulMemClass.coe_mul] - trans (1 : ℂ) • ((superCommute (anPart φ)) (ofFieldOp φs[k.1]) * ↑φsΛ.staticContract) - · simp - simp only [smul_smul] - congr 1 have h1 : ofList 𝓕.fieldOpStatistic (List.take (↑(φsΛ.uncontractedIndexEquiv.symm k)) (List.map φs.get φsΛ.uncontractedList)) = (𝓕 |>ₛ ⟨φs.get, (Finset.filter (fun x => x < k) φsΛ.uncontracted)⟩) := by @@ -107,23 +97,16 @@ lemma staticContract_insert_some_of_lt congr rw [← List.map_take] congr - rw [take_uncontractedIndexEquiv_symm] - rw [filter_uncontractedList] - rw [h1] - simp only [exchangeSign_mul_self] + rw [take_uncontractedIndexEquiv_symm, filter_uncontractedList] + rw [h1, smul_smul, exchangeSign_mul_self, one_smul] lemma staticContract_of_not_gradingCompliant (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) (h : ¬ GradingCompliant φs φsΛ) : φsΛ.staticContract = 0 := by rw [staticContract] simp only [GradingCompliant, Subtype.forall, not_forall] at h - obtain ⟨a, ha⟩ := h - obtain ⟨ha, ha2⟩ := ha - apply Finset.prod_eq_zero (i := ⟨a, ha⟩) - simp only [Finset.univ_eq_attach, Finset.mem_attach] - apply Subtype.ext - simp only [List.get_eq_getElem, ZeroMemClass.coe_zero] - rw [superCommute_anPart_ofFieldOpF_diff_grade_zero] - simp [ha2] + obtain ⟨a, ha, ha2⟩ := h + refine Finset.prod_eq_zero (Finset.mem_univ ⟨a, ha⟩) (Subtype.ext ?_) + exact superCommute_anPart_ofFieldOpF_diff_grade_zero _ _ ha2 end WickContraction diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean b/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean index b50b356d8..7e3b4e4bd 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean @@ -37,19 +37,13 @@ variable {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) lemma timeOrderRel_of_eqTimeOnly_pair {i j : Fin φs.length} (h : {i, j} ∈ φsΛ.1) (hc : EqTimeOnly φsΛ) : - timeOrderRel φs[i] φs[j] := by - have h' := hc - simp only [EqTimeOnly, Fin.getElem_fin] at h' - exact h' i j h + timeOrderRel φs[i] φs[j] := hc i j h lemma timeOrderRel_both_of_eqTimeOnly {i j : Fin φs.length} (h : {i, j} ∈ φsΛ.1) (hc : EqTimeOnly φsΛ) : - timeOrderRel φs[i] φs[j] ∧ timeOrderRel φs[j] φs[i] := by - apply And.intro - · exact timeOrderRel_of_eqTimeOnly_pair φsΛ h hc - · apply timeOrderRel_of_eqTimeOnly_pair φsΛ _ hc - rw [@Finset.pair_comm] - exact h + timeOrderRel φs[i] φs[j] ∧ timeOrderRel φs[j] φs[i] := + ⟨timeOrderRel_of_eqTimeOnly_pair φsΛ h hc, + timeOrderRel_of_eqTimeOnly_pair φsΛ (by simpa [Finset.pair_comm] using h) hc⟩ lemma eqTimeOnly_iff_forall_finset {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) : φsΛ.EqTimeOnly ↔ ∀ (a : φsΛ.1), @@ -65,32 +59,20 @@ lemma eqTimeOnly_iff_forall_finset {φs : List 𝓕.FieldOp} (φsΛ : WickContra intro i j h1 have h' := h ⟨{i, j}, h1⟩ by_cases hij: i < j - · have hi : φsΛ.fstFieldOfContract ⟨{i, j}, h1⟩ = i := by - apply eq_fstFieldOfContract_of_mem _ _ i j - · simp - · simp - · exact hij - have hj : φsΛ.sndFieldOfContract ⟨{i, j}, h1⟩ = j := by - apply eq_sndFieldOfContract_of_mem _ _ i j - · simp - · simp - · exact hij + · have hi : φsΛ.fstFieldOfContract ⟨{i, j}, h1⟩ = i := + eq_fstFieldOfContract_of_mem _ _ i j (by simp) (by simp) hij + have hj : φsΛ.sndFieldOfContract ⟨{i, j}, h1⟩ = j := + eq_sndFieldOfContract_of_mem _ _ i j (by simp) (by simp) hij simp_all · have hij : i ≠ j := by by_contra hij subst hij have h2 := φsΛ.2.1 {i, i} h1 simp at h2 - have hj : φsΛ.fstFieldOfContract ⟨{i, j}, h1⟩ = j := by - apply eq_fstFieldOfContract_of_mem _ _ j i - · simp - · simp - · omega - have hi : φsΛ.sndFieldOfContract ⟨{i, j}, h1⟩ = i := by - apply eq_sndFieldOfContract_of_mem _ _ j i - · simp - · simp - · omega + have hj : φsΛ.fstFieldOfContract ⟨{i, j}, h1⟩ = j := + eq_fstFieldOfContract_of_mem _ _ j i (by simp) (by simp) (by omega) + have hi : φsΛ.sndFieldOfContract ⟨{i, j}, h1⟩ = i := + eq_sndFieldOfContract_of_mem _ _ j i (by simp) (by simp) (by omega) simp_all @[simp] @@ -109,10 +91,8 @@ lemma staticContract_eq_timeContract_of_eqTimeOnly (h : φsΛ.EqTimeOnly) : ext simp only [List.get_eq_getElem] rw [timeContract_of_timeOrderRel] - apply timeOrderRel_of_eqTimeOnly_pair φsΛ - rw [← finset_eq_fstFieldOfContract_sndFieldOfContract] - exact a.2 - exact h + refine timeOrderRel_of_eqTimeOnly_pair φsΛ ?_ h + simp [← finset_eq_fstFieldOfContract_sndFieldOfContract, a.2] lemma eqTimeOnly_congr {φs φs' : List 𝓕.FieldOp} (h : φs = φs') (φsΛ : WickContraction φs.length) : (congr (by simp [h]) φsΛ).EqTimeOnly (φs := φs') ↔ φsΛ.EqTimeOnly := by @@ -125,8 +105,7 @@ lemma quotContraction_eqTimeOnly {φs : List 𝓕.FieldOp} {φsΛ : WickContract rw [eqTimeOnly_iff_forall_finset] intro a simp only [Fin.getElem_fin] - erw [subContraction_uncontractedList_get] - erw [subContraction_uncontractedList_get] + erw [subContraction_uncontractedList_get, subContraction_uncontractedList_get] simp only [quotContraction_fstFieldOfContract_uncontractedListEmd, Fin.getElem_fin, quotContraction_sndFieldOfContract_uncontractedListEmd] rw [eqTimeOnly_iff_forall_finset] at h @@ -152,11 +131,9 @@ lemma exists_join_singleton_of_card_ge_zero {φs : List 𝓕.FieldOp} (φsΛ : W · have h1 := join_congr (subContraction_singleton_eq_singleton _ ⟨a, ha⟩).symm (φsucΛ := φsucΛ) simp only [h1, congr_trans_apply, congr_refl, φsucΛ] rw [join_sub_quot] - · apply And.intro + · refine ⟨?_, ?_, ?_⟩ · apply timeOrderRel_both_of_eqTimeOnly φsΛ _ h1 - rw [← finset_eq_fstFieldOfContract_sndFieldOfContract] - simp [ha] - apply And.intro + simp [← finset_eq_fstFieldOfContract_sndFieldOfContract, ha] · simp only [φsucΛ] rw [eqTimeOnly_congr (φs := [(φsΛ.subContraction {a} (by simpa using ha))]ᵘᶜ)] exact quotContraction_eqTimeOnly h1 _ _ @@ -186,14 +163,13 @@ lemma timeOrder_timeContract_mul_of_eqTimeOnly_mid_induction {φs : List 𝓕.Fi have ih := timeOrder_timeContract_mul_of_eqTimeOnly_mid_induction φsucΛ h3 a b n (by omega) rw [← mul_assoc, ih] simp only [Fin.getElem_fin, mul_assoc] - simp_all only [Nat.succ_eq_add_one, Fin.getElem_fin, add_left_inj] - simp_all + all_goals simp_all lemma timeOrder_timeContract_mul_of_eqTimeOnly_mid {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (hl : φsΛ.EqTimeOnly) (a b : 𝓕.WickAlgebra) : - 𝓣(a * φsΛ.timeContract.1 * b) = φsΛ.timeContract.1 * 𝓣(a * b) := by - exact timeOrder_timeContract_mul_of_eqTimeOnly_mid_induction φsΛ hl a b φsΛ.1.card rfl + 𝓣(a * φsΛ.timeContract.1 * b) = φsΛ.timeContract.1 * 𝓣(a * b) := + timeOrder_timeContract_mul_of_eqTimeOnly_mid_induction φsΛ hl a b φsΛ.1.card rfl /-- Let `φs` be a list of `𝓕.FieldOp`, `φsΛ` a `WickContraction` of `φs` within which every contraction involves two `𝓕.FieldOp`s that have the same time and @@ -231,10 +207,7 @@ lemma exists_join_singleton_of_not_eqTimeOnly {φs : List 𝓕.FieldOp} · have h1 := join_congr (subContraction_singleton_eq_singleton _ ⟨a, ha⟩).symm (φsucΛ := φsucΛ) simp only [h1, congr_trans_apply, congr_refl, φsucΛ] rw [join_sub_quot] - · by_cases h1 : timeOrderRel φs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)] - φs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)] - · simp_all - · simp_all + · tauto lemma timeOrder_timeContract_of_not_eqTimeOnly {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) @@ -246,9 +219,7 @@ lemma timeOrder_timeContract_of_not_eqTimeOnly {φs : List 𝓕.FieldOp} rw [timeOrder_timeOrder_left] rw [timeOrder_timeContract_ne_time] simp only [zero_mul, map_zero] - simp_all only [Fin.getElem_fin, not_and] - intro h - simp_all + tauto /-- Let `φs` be a list of `𝓕.FieldOp` and `φsΛ` a `WickContraction` with at least one contraction between `𝓕.FieldOp` that do not have the same time. Then @@ -262,8 +233,7 @@ lemma timeOrder_staticContract_of_not_mem {φs : List 𝓕.FieldOp} (φsΛ : Wic rw [timeOrder_timeOrder_left] rw [timeOrder_superCommute_anPart_ofFieldOp_ne_time] simp only [zero_mul, map_zero] - intro h - simp_all + tauto end EqTimeOnly @@ -291,7 +261,6 @@ lemma haveEqTime_iff_finset {φs : List 𝓕.FieldOp} (φsΛ : WickContraction by_cases hij : i < j · have h1n := eq_fstFieldOfContract_of_mem φsΛ ⟨{i,j}, h1⟩ i j (by simp) (by simp) hij have h2n := eq_sndFieldOfContract_of_mem φsΛ ⟨{i,j}, h1⟩ i j (by simp) (by simp) hij - simp only [h1n, h2n] simp_all only [true_and] · have hineqj : i ≠ j := by by_contra hineqj @@ -301,7 +270,6 @@ lemma haveEqTime_iff_finset {φs : List 𝓕.FieldOp} (φsΛ : WickContraction have hji : j < i := by omega have h1n := eq_fstFieldOfContract_of_mem φsΛ ⟨{i,j}, h1⟩ j i (by simp) (by simp) hji have h2n := eq_sndFieldOfContract_of_mem φsΛ ⟨{i,j}, h1⟩ j i (by simp) (by simp) hji - simp only [h1n, h2n] simp_all · intro h obtain ⟨a, h1, h2, h3⟩ := h @@ -327,16 +295,13 @@ def eqTimeContractSet {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.len lemma eqTimeContractSet_subset {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) : eqTimeContractSet φsΛ ⊆ φsΛ.1 := by - simp only [eqTimeContractSet, Fin.getElem_fin] - intro a - simp only [Finset.mem_filter, Finset.mem_univ, true_and, and_imp] - intro h _ - exact h + intro a ha + simp only [eqTimeContractSet, Finset.mem_filter, Finset.mem_univ, true_and] at ha + exact ha.1 lemma mem_of_mem_eqTimeContractSet{φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} - {a : Finset (Fin φs.length)} (h : a ∈ eqTimeContractSet φsΛ) : a ∈ φsΛ.1 := by - simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, true_and] at h - exact h.1 + {a : Finset (Fin φs.length)} (h : a ∈ eqTimeContractSet φsΛ) : a ∈ φsΛ.1 := + eqTimeContractSet_subset φsΛ h lemma join_eqTimeContractSet {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) : @@ -347,10 +312,9 @@ lemma join_eqTimeContractSet {φs : List 𝓕.FieldOp} (φsΛ : WickContraction · intro h have hmem := mem_of_mem_eqTimeContractSet h have ht := joinLiftLeft_or_joinLiftRight_of_mem_join (φsucΛ := φsucΛ) _ hmem + simp only [Finset.le_eq_subset, Finset.mem_union, Finset.mem_map, RelEmbedding.coe_toEmbedding] rcases ht with ht | ht · obtain ⟨b, rfl⟩ := ht - simp only [Finset.le_eq_subset, Finset.mem_union, Finset.mem_map, - RelEmbedding.coe_toEmbedding] left simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, true_and] apply And.intro (by simp [joinLiftLeft]) @@ -360,8 +324,6 @@ lemma join_eqTimeContractSet {φs : List 𝓕.FieldOp} (φsΛ : WickContraction join_sndFieldOfContract_joinLift, forall_true_left, true_and] at h exact h · obtain ⟨b, rfl⟩ := ht - simp only [Finset.le_eq_subset, Finset.mem_union, Finset.mem_map, - RelEmbedding.coe_toEmbedding] right use b rw [Finset.mapEmbedding_apply] @@ -371,27 +333,19 @@ lemma join_eqTimeContractSet {φs : List 𝓕.FieldOp} (φsΛ : WickContraction simp only [Finset.le_eq_subset, Finset.mem_union, Finset.mem_map, RelEmbedding.coe_toEmbedding] at h rcases h with h | h - · simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, true_and] - simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, - true_and] at h - apply And.intro - · simp [join, h.1] - · intro h' - have h2 := h.2 h.1 - exact h2 - · simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, true_and] - simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, - true_and] at h + · simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, + true_and] at h ⊢ + exact ⟨by simp [join, h.1], fun _ => h.2 h.1⟩ + · simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, + true_and] at h ⊢ obtain ⟨b, h1, h2, rfl⟩ := h - apply And.intro - · simp [join, h1] - · intro h' - have h2 := h1.2 h1.1 - have hj : ⟨(Finset.mapEmbedding uncontractedListEmd) b, h'⟩ - = joinLiftRight ⟨b, h1.1⟩ := by rfl - simp only [hj, join_fstFieldOfContract_joinLiftRight, getElem_uncontractedListEmd, - join_sndFieldOfContract_joinLiftRight] - simpa using h2 + refine ⟨by simp [join, h1], fun h' => ?_⟩ + have h2 := h1.2 h1.1 + have hj : ⟨(Finset.mapEmbedding uncontractedListEmd) b, h'⟩ + = joinLiftRight ⟨b, h1.1⟩ := by rfl + simp only [hj, join_fstFieldOfContract_joinLiftRight, getElem_uncontractedListEmd, + join_sndFieldOfContract_joinLiftRight] + simpa using h2 lemma eqTimeContractSet_of_not_haveEqTime {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} (h : ¬ HaveEqTime φsΛ) : eqTimeContractSet φsΛ = ∅ := by @@ -401,8 +355,7 @@ lemma eqTimeContractSet_of_not_haveEqTime {φs : List 𝓕.FieldOp} {φsΛ : Wic rw [haveEqTime_iff_finset] at h simp only [Fin.getElem_fin, not_exists, not_and] at h simp only [eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, true_and] at hn - have h2 := hn.2 hn.1 - simp_all + exact h a hn.1 (hn.2 hn.1).1 (hn.2 hn.1).2 lemma eqTimeContractSet_of_mem_eqTimeOnly {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} (h : φsΛ.EqTimeOnly) : eqTimeContractSet φsΛ = φsΛ.1 := by @@ -430,7 +383,6 @@ lemma pair_mem_eqTimeContractSet_iff {φs : List 𝓕.FieldOp} {i j : Fin φs.le by_cases hij : i < j · have h1 := eq_fstFieldOfContract_of_mem φsΛ ⟨{i,j}, h⟩ i j (by simp) (by simp) hij have h2 := eq_sndFieldOfContract_of_mem φsΛ ⟨{i,j}, h⟩ i j (by simp) (by simp) hij - simp only [h1, h2] simp_all only [forall_true_left, true_and] · have hineqj : i ≠ j := by by_contra hineqj @@ -442,11 +394,7 @@ lemma pair_mem_eqTimeContractSet_iff {φs : List 𝓕.FieldOp} {i j : Fin φs.le have h2 := eq_sndFieldOfContract_of_mem φsΛ ⟨{i,j}, h⟩ j i (by simp) (by simp) hji simp only [h1, h2] simp_all only [not_lt, ne_eq, forall_true_left, true_and] - apply Iff.intro - · intro a - simp_all only [and_self] - · intro a - simp_all only [and_self] + exact and_comm lemma subContraction_eqTimeContractSet_not_empty_of_haveEqTime {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h : HaveEqTime φsΛ) : @@ -459,9 +407,8 @@ lemma subContraction_eqTimeContractSet_not_empty_of_haveEqTime obtain ⟨i, j, hij, h1, h2⟩ := h simp only [not_forall, Decidable.not_not] use {i, j} - rw [pair_mem_eqTimeContractSet_iff] + rw [pair_mem_eqTimeContractSet_iff φsΛ h1] simp_all only [Fin.getElem_fin, and_self] - exact h1 set_option backward.isDefEq.respectTransparency false in lemma quotContraction_eqTimeContractSet_not_haveEqTime {φs : List 𝓕.FieldOp} @@ -470,18 +417,16 @@ lemma quotContraction_eqTimeContractSet_not_haveEqTime {φs : List 𝓕.FieldOp} rw [haveEqTime_iff_finset] simp only [Fin.getElem_fin, not_exists, not_and] intro a ha - erw [subContraction_uncontractedList_get] - erw [subContraction_uncontractedList_get] + erw [subContraction_uncontractedList_get, subContraction_uncontractedList_get] simp only [quotContraction_fstFieldOfContract_uncontractedListEmd, Fin.getElem_fin, quotContraction_sndFieldOfContract_uncontractedListEmd] simp only [quotContraction, Finset.mem_filter, Finset.mem_univ, true_and] at ha have hn' : Finset.map uncontractedListEmd a ∉ - (φsΛ.subContraction (eqTimeContractSet φsΛ) (eqTimeContractSet_subset φsΛ)).1 := by - exact uncontractedListEmd_finset_not_mem a + (φsΛ.subContraction (eqTimeContractSet φsΛ) (eqTimeContractSet_subset φsΛ)).1 := + uncontractedListEmd_finset_not_mem a simp only [subContraction, eqTimeContractSet, Fin.getElem_fin, Finset.mem_filter, Finset.mem_univ, true_and, not_and, not_forall] at hn' - have hn'' := hn' ha - obtain ⟨h, h1⟩ := hn'' + obtain ⟨h, h1⟩ := hn' ha simp_all lemma join_haveEqTime_of_eqTimeOnly_nonEmpty {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) @@ -494,9 +439,7 @@ lemma join_haveEqTime_of_eqTimeOnly_nonEmpty {φs : List 𝓕.FieldOp} (φsΛ : obtain ⟨i, j, h⟩ := exists_pair_of_not_eq_empty _ h2 use i, j simp_all only [ne_eq, true_or, true_and] - apply h1 j i - rw [Finset.pair_comm] - exact h + exact h1 j i (by simpa [Finset.pair_comm] using h) lemma hasEqTimeEquiv_ext_sigma {φs : List 𝓕.FieldOp} {x1 x2 : Σ (φsΛ : {φsΛ : WickContraction φs.length // φsΛ.EqTimeOnly ∧ φsΛ ≠ empty}), diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean b/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean index 732cf0dfe..b05a20c6f 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean @@ -29,40 +29,21 @@ open Physlib.Fin -/ lemma fin_list_sorted_monotone_sorted {n m : ℕ} (l: List (Fin n)) (hl : l.Pairwise (· ≤ ·)) - (f : Fin n → Fin m) (hf : StrictMono f) : (List.map f l).Pairwise (· ≤ ·) := by - induction l with - | nil => simp - | cons a l ih => - simp only [List.map_cons, List.pairwise_cons, List.mem_map, forall_exists_index, and_imp, - forall_apply_eq_imp_iff₂] - apply And.intro - · simp only [List.pairwise_cons] at hl - intro b hb - have hl1 := hl.1 b hb - exact (StrictMono.le_iff_le hf).mpr hl1 - · simp only [List.pairwise_cons] at hl - exact ih hl.2 + (f : Fin n → Fin m) (hf : StrictMono f) : (List.map f l).Pairwise (· ≤ ·) := + hl.map f fun _ _ hab => hf.monotone hab lemma fin_list_sorted_succAboveEmb_sorted (l: List (Fin n)) (hl : l.Pairwise (· ≤ ·)) (i : Fin n.succ) : ((List.map i.succAboveEmb l)).Pairwise (· ≤ ·) := by - apply fin_list_sorted_monotone_sorted - exact hl - simp only [Fin.coe_succAboveEmb] - exact Fin.strictMono_succAbove i + refine fin_list_sorted_monotone_sorted l hl i.succAboveEmb ?_ + simpa only [Fin.coe_succAboveEmb] using Fin.strictMono_succAbove i lemma fin_finset_sort_map_monotone {n m : ℕ} (a : Finset (Fin n)) (f : Fin n ↪ Fin m) (hf : StrictMono f) : (a.sort (· ≤ ·)).map f = ((a.map f).sort (· ≤ ·)) := by - have h1 : ((a.sort (· ≤ ·)).map f).Pairwise (· ≤ ·) := by - apply fin_list_sorted_monotone_sorted - exact a.pairwise_sort (fun x1 x2 => x1 ≤ x2) - exact hf - have h2 : ((a.sort (· ≤ ·)).map f).Nodup := by - refine (List.nodup_map_iff_inj_on ?_).mpr ?_ - exact a.sort_nodup (fun x1 x2 => x1 ≤ x2) - intro a ha b hb hf - exact f.2 hf - have h3 : ((a.sort (· ≤ ·)).map f).toFinset = (a.map f) := by + have h1 : ((a.sort (· ≤ ·)).map f).Pairwise (· ≤ ·) := + fin_list_sorted_monotone_sorted _ (a.pairwise_sort _) f hf + have h2 : ((a.sort (· ≤ ·)).map f).Nodup := (a.sort_nodup _).map f.injective + have h3 : ((a.sort (· ≤ ·)).map f).toFinset = a.map f := by ext a simp rw [← h3] @@ -111,11 +92,9 @@ lemma fin_list_sorted_indexOf_filter_le_mem : · simp only [ha, decide_true, List.filter_cons_of_pos] have ha : a = i := by simp only [List.mem_cons] at hi - rcases hi with hi | hi - · subst hi - rfl - · have hl' := hl.1 i hi - exact Fin.le_antisymm hl' ha + rcases hi with rfl | hi + · rfl + · exact Fin.le_antisymm (hl.1 i hi) ha subst ha simp · simp only [not_le] at ha @@ -173,17 +152,13 @@ lemma orderedInsert_eq_insertIdx_of_fin_list_sorted (l : List (Fin n)) (hl : l.P omega⟩ simp only [Fin.val_fin_lt] conv_rhs => rw [insertIdx_eq_take_drop _ _ n] - rw [orderedInsert_of_fin_list_sorted] + rw [orderedInsert_of_fin_list_sorted l hl i] congr - · conv_rhs => + all_goals + conv_rhs => rhs rw [fin_list_sorted_split l hl i] simp [n] - · conv_rhs => - rhs - rw [fin_list_sorted_split l hl i] - simp [n] - exact hl /-! @@ -213,15 +188,13 @@ lemma congr_uncontractedList {n m : ℕ} (h : n = m) (c : WickContraction n) : lemma uncontractedList_get_mem_uncontracted (i : Fin c.uncontractedList.length) : c.uncontractedList.get i ∈ c.uncontracted := by - rw [← uncontractedList_mem_iff] - simp + simp [← uncontractedList_mem_iff] lemma uncontractedList_sorted : List.Pairwise (· ≤ ·) c.uncontractedList := by rw [uncontractedList] apply List.Pairwise.filter rw [← List.ofFn_id] - refine List.sortedLE_iff_pairwise.mp ?_ - exact Monotone.sortedLE_ofFn fun ⦃a b⦄ a => a + exact List.pairwise_ofFn.mpr fun _ _ h => h.le lemma uncontractedList_sorted_lt : List.Pairwise (· < ·) c.uncontractedList := by rw [uncontractedList] @@ -231,8 +204,7 @@ lemma uncontractedList_sorted_lt : List.Pairwise (· < ·) c.uncontractedList := lemma uncontractedList_nodup : c.uncontractedList.Nodup := by rw [uncontractedList] - refine List.Nodup.filter (fun x => decide (x ∈ c.uncontracted)) ?_ - exact List.nodup_finRange n + exact (List.nodup_finRange n).filter _ lemma uncontractedList_toFinset (c : WickContraction n) : c.uncontractedList.toFinset = c.uncontracted := by @@ -242,31 +214,24 @@ lemma uncontractedList_eq_sort (c : WickContraction n) : c.uncontractedList = c.uncontracted.sort (· ≤ ·) := by symm rw [← uncontractedList_toFinset] - refine (List.toFinset_sort (α := Fin n) (· ≤ ·) ?_).mpr ?_ - · exact uncontractedList_nodup c - · exact uncontractedList_sorted c + exact (List.toFinset_sort (α := Fin n) (· ≤ ·) (uncontractedList_nodup c)).mpr + (uncontractedList_sorted c) lemma uncontractedList_length_eq_card (c : WickContraction n) : c.uncontractedList.length = c.uncontracted.card := by - rw [uncontractedList_eq_sort] - exact Finset.length_sort fun x1 x2 => x1 ≤ x2 + rw [uncontractedList_eq_sort, Finset.length_sort] lemma filter_uncontractedList (c : WickContraction n) (p : Fin n → Prop) [DecidablePred p] : (c.uncontractedList.filter p) = (c.uncontracted.filter p).sort (· ≤ ·) := by - have h1 : (c.uncontractedList.filter p).Pairwise (· ≤ ·) := by - apply List.Pairwise.filter - exact uncontractedList_sorted c - have h2 : (c.uncontractedList.filter p).Nodup := by - refine List.Nodup.filter _ ?_ - exact uncontractedList_nodup c - have h3 : (c.uncontractedList.filter p).toFinset = (c.uncontracted.filter p) := by + have h1 : (c.uncontractedList.filter p).Pairwise (· ≤ ·) := (uncontractedList_sorted c).filter _ + have h2 : (c.uncontractedList.filter p).Nodup := (uncontractedList_nodup c).filter _ + have h3 : (c.uncontractedList.filter p).toFinset = c.uncontracted.filter p := by ext a simp only [List.toFinset_filter, decide_eq_true_eq, Finset.mem_filter, List.mem_toFinset, and_congr_left_iff] rw [uncontractedList_mem_iff] simp - have hx := (List.toFinset_sort (· ≤ ·) h2).mpr h1 - rw [← hx, h3] + rw [← (List.toFinset_sort (· ≤ ·) h2).mpr h1, h3] /-! @@ -298,19 +263,16 @@ lemma uncontractedIndexEquiv_symm_eq_filter_length (k : c.uncontracted) : (c.uncontractedIndexEquiv.symm k).val = (List.filter (fun i => i < k.val) c.uncontractedList).length := by simp only [uncontractedIndexEquiv, List.get_eq_getElem, Equiv.coe_fn_symm_mk] - rw [fin_list_sorted_indexOf_mem] - · simp - · exact uncontractedList_sorted c - · rw [uncontractedList_mem_iff] - exact k.2 + rw [fin_list_sorted_indexOf_mem _ (uncontractedList_sorted c) _ + ((c.uncontractedList_mem_iff _).mpr k.2)] + simp lemma take_uncontractedIndexEquiv_symm (k : c.uncontracted) : c.uncontractedList.take (c.uncontractedIndexEquiv.symm k).val = c.uncontractedList.filter (fun i => i < k.val) := by - have hl := fin_list_sorted_split c.uncontractedList (uncontractedList_sorted c) k.val conv_lhs => rhs - rw [hl] + rw [fin_list_sorted_split c.uncontractedList (uncontractedList_sorted c) k.val] rw [uncontractedIndexEquiv_symm_eq_filter_length] simp /-! @@ -388,9 +350,7 @@ lemma uncontractedListEmd_strictMono {φs : List 𝓕.FieldOp} {φsΛ : WickCont simp only [uncontractedListEmd, uncontractedIndexEquiv, List.get_eq_getElem, Equiv.trans_toEmbedding, Function.Embedding.trans_apply, Equiv.coe_toEmbedding, finCongr_apply, Equiv.coe_fn_mk, Fin.val_cast, Function.Embedding.coe_subtype] - apply List.SortedLT.strictMono_get - exact φsΛ.uncontractedList_sorted_lt.sortedLT - exact h + exact φsΛ.uncontractedList_sorted_lt.sortedLT.strictMono_get h lemma uncontractedListEmd_mem_uncontracted {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} (i : Fin [φsΛ]ᵘᶜ.length) : uncontractedListEmd i ∈ φsΛ.uncontracted := by @@ -401,11 +361,10 @@ lemma uncontractedListEmd_surjective_mem_uncontracted {φs : List 𝓕.FieldOp} ∃ j, φsΛ.uncontractedListEmd j = i := by simp only [uncontractedListEmd, Equiv.trans_toEmbedding, Function.Embedding.trans_apply, Equiv.coe_toEmbedding, finCongr_apply, Function.Embedding.coe_subtype] - have hj : ∃ j, φsΛ.uncontractedIndexEquiv j = ⟨i, hi⟩ := by - exact φsΛ.uncontractedIndexEquiv.surjective ⟨i, hi⟩ + have hj : ∃ j, φsΛ.uncontractedIndexEquiv j = ⟨i, hi⟩ := + φsΛ.uncontractedIndexEquiv.surjective ⟨i, hi⟩ generalize_proofs h1 obtain ⟨j, hj⟩ := hj - have hj' : ∃ j', Fin.cast h1 j' = j := (finCongr h1).surjective j obtain ⟨j', rfl⟩ := (finCongr h1).surjective j use j' erw [hj] @@ -418,8 +377,7 @@ lemma uncontractedListEmd_finset_disjoint_left {φs : List 𝓕.FieldOp} intro x hx simp only [Finset.mem_map] at hx obtain ⟨x, hx, rfl⟩ := hx - have h1 : uncontractedListEmd x ∈ φsΛ.uncontracted := - uncontractedListEmd_mem_uncontracted x + have h1 := uncontractedListEmd_mem_uncontracted x rw [mem_uncontracted_iff_not_contracted] at h1 exact h1 b hb @@ -430,8 +388,7 @@ lemma uncontractedListEmd_finset_not_mem {φs : List 𝓕.FieldOp} {φsΛ : Wick have h1 := uncontractedListEmd_finset_disjoint_left a (a.map uncontractedListEmd) hn simp only [disjoint_self, Finset.bot_eq_empty, Finset.map_eq_empty] at h1 have h2 := φsΛ.2.1 (a.map uncontractedListEmd) hn - rw [h1] at h2 - simp at h2 + simp [h1] at h2 @[simp] lemma getElem_uncontractedListEmd {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} @@ -453,40 +410,27 @@ lemma uncontractedListEmd_empty {φs : List 𝓕.FieldOp} : lemma uncontractedList_succAboveEmb_sorted (c : WickContraction n) (i : Fin n.succ) : ((List.map i.succAboveEmb c.uncontractedList)).Pairwise (· ≤ ·) := by - apply fin_list_sorted_succAboveEmb_sorted - exact uncontractedList_sorted c + exact fin_list_sorted_succAboveEmb_sorted _ (uncontractedList_sorted c) i lemma uncontractedList_succAboveEmb_nodup (c : WickContraction n) (i : Fin n.succ) : ((List.map i.succAboveEmb c.uncontractedList)).Nodup := by - refine List.Nodup.map ?_ ?_ - · exact Function.Embedding.injective i.succAboveEmb - · exact uncontractedList_nodup c + exact (uncontractedList_nodup c).map i.succAboveEmb.injective lemma uncontractedList_succAbove_orderedInsert_nodup (c : WickContraction n) (i : Fin n.succ) : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Nodup := by - have h1 : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Perm - (i :: List.map i.succAboveEmb c.uncontractedList) := by - exact List.perm_orderedInsert (fun x1 x2 => x1 ≤ x2) i _ - apply List.Perm.nodup h1.symm - simp only [Nat.succ_eq_add_one, List.nodup_cons, List.mem_map, not_exists, - not_and] - apply And.intro - · intro x _ - exact Fin.succAbove_ne i x - · exact uncontractedList_succAboveEmb_nodup c i + apply (List.perm_orderedInsert (· ≤ ·) i _).symm.nodup + simp only [Nat.succ_eq_add_one, List.nodup_cons, List.mem_map, not_exists, not_and] + exact ⟨fun x _ => Fin.succAbove_ne i x, uncontractedList_succAboveEmb_nodup c i⟩ lemma uncontractedList_succAbove_orderedInsert_sorted (c : WickContraction n) (i : Fin n.succ) : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Pairwise (· ≤ ·) := by - refine List.Pairwise.orderedInsert i (List.map (⇑i.succAboveEmb) c.uncontractedList) ?_ - exact uncontractedList_succAboveEmb_sorted c i + exact List.Pairwise.orderedInsert i _ (uncontractedList_succAboveEmb_sorted c i) lemma uncontractedList_succAbove_orderedInsert_toFinset (c : WickContraction n) (i : Fin n.succ) : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).toFinset = (Insert.insert i (Finset.map i.succAboveEmb c.uncontracted)) := by ext a - simp only [Nat.succ_eq_add_one, Fin.coe_succAboveEmb, List.mem_toFinset, List.mem_orderedInsert, - List.mem_map, Finset.mem_insert, Finset.mem_map, Fin.succAboveEmb_apply] rw [← uncontractedList_toFinset] simp @@ -494,16 +438,15 @@ lemma uncontractedList_succAbove_orderedInsert_eq_sort (c : WickContraction n) ( (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)) = (Insert.insert i (Finset.map i.succAboveEmb c.uncontracted)).sort (· ≤ ·) := by rw [← uncontractedList_succAbove_orderedInsert_toFinset] - symm - refine (List.toFinset_sort (α := Fin n.succ) (· ≤ ·) ?_).mpr ?_ - · exact uncontractedList_succAbove_orderedInsert_nodup c i - · exact uncontractedList_succAbove_orderedInsert_sorted c i + exact ((List.toFinset_sort (α := Fin n.succ) (· ≤ ·) + (uncontractedList_succAbove_orderedInsert_nodup c i)).mpr + (uncontractedList_succAbove_orderedInsert_sorted c i)).symm lemma uncontractedList_extractEquiv_symm_none (c : WickContraction n) (i : Fin n.succ) : ((extractEquiv i).symm ⟨c, none⟩).uncontractedList = List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList) := by - rw [uncontractedList_eq_sort, extractEquiv_symm_none_uncontracted] - rw [uncontractedList_succAbove_orderedInsert_eq_sort] + rw [uncontractedList_eq_sort, extractEquiv_symm_none_uncontracted, + uncontractedList_succAbove_orderedInsert_eq_sort] /-! @@ -519,25 +462,9 @@ lemma uncontractedList_succAboveEmb_eraseIdx_toFinset (c : WickContraction n) (i simp only [Fin.coe_succAboveEmb, List.mem_toFinset, Fin.succAboveEmb_apply, Finset.mem_erase, ne_eq, Finset.mem_map] rw [mem_eraseIdx_nodup _ _ _ (by simpa using hk)] - simp_all only [List.mem_map, List.getElem_map, ne_eq] - apply Iff.intro - · intro a_1 - simp_all only [not_false_eq_true, true_and] - obtain ⟨left, right⟩ := a_1 - obtain ⟨w, h⟩ := left - obtain ⟨left, right_1⟩ := h - subst right_1 - use w - simp_all [uncontractedList] - · intro a_1 - simp_all only [not_false_eq_true, and_true] - obtain ⟨left, right⟩ := a_1 - obtain ⟨w, h⟩ := right - obtain ⟨left_1, right⟩ := h - subst right - use w - simp_all [uncontractedList] - exact uncontractedList_succAboveEmb_nodup c i + · simp only [List.mem_map, List.getElem_map, ne_eq, uncontractedList_mem_iff] + tauto + · exact uncontractedList_succAboveEmb_nodup c i lemma uncontractedList_succAboveEmb_eraseIdx_sorted (c : WickContraction n) (i : Fin n.succ) (k: ℕ) : ((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Pairwise (· ≤ ·) := by @@ -546,8 +473,7 @@ lemma uncontractedList_succAboveEmb_eraseIdx_sorted (c : WickContraction n) (i : lemma uncontractedList_succAboveEmb_eraseIdx_nodup (c : WickContraction n) (i : Fin n.succ) (k: ℕ) : ((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Nodup := by - refine List.Nodup.eraseIdx k ?_ - exact uncontractedList_succAboveEmb_nodup c i + exact (uncontractedList_succAboveEmb_nodup c i).eraseIdx k lemma uncontractedList_succAboveEmb_eraseIdx_eq_sort (c : WickContraction n) (i : Fin n.succ) (k : ℕ) (hk : k < c.uncontractedList.length) : @@ -555,16 +481,14 @@ lemma uncontractedList_succAboveEmb_eraseIdx_eq_sort (c : WickContraction n) (i ((c.uncontracted.map i.succAboveEmb).erase (i.succAboveEmb c.uncontractedList[k])).sort (· ≤ ·) := by rw [← uncontractedList_succAboveEmb_eraseIdx_toFinset] - symm - refine (List.toFinset_sort (α := Fin n.succ) (· ≤ ·) ?_).mpr ?_ - · exact uncontractedList_succAboveEmb_eraseIdx_nodup c i k - · exact uncontractedList_succAboveEmb_eraseIdx_sorted c i k + exact ((List.toFinset_sort (α := Fin n.succ) (· ≤ ·) + (uncontractedList_succAboveEmb_eraseIdx_nodup c i k)).mpr + (uncontractedList_succAboveEmb_eraseIdx_sorted c i k)).symm lemma uncontractedList_extractEquiv_symm_some (c : WickContraction n) (i : Fin n.succ) (k : c.uncontracted) : ((extractEquiv i).symm ⟨c, some k⟩).uncontractedList = ((c.uncontractedList).map i.succAboveEmb).eraseIdx (c.uncontractedIndexEquiv.symm k) := by - rw [uncontractedList_eq_sort] - rw [uncontractedList_succAboveEmb_eraseIdx_eq_sort] + rw [uncontractedList_eq_sort, uncontractedList_succAboveEmb_eraseIdx_eq_sort] swap simp only [Fin.is_lt] congr @@ -578,8 +502,6 @@ lemma uncontractedList_succAboveEmb_toFinset (c : WickContraction n) (i : Fin n. (List.map i.succAboveEmb c.uncontractedList).toFinset = (Finset.map i.succAboveEmb c.uncontracted) := by ext a - simp only [Fin.coe_succAboveEmb, List.mem_toFinset, List.mem_map, Finset.mem_map, - Fin.succAboveEmb_apply] rw [← c.uncontractedList_toFinset] simp @@ -599,51 +521,37 @@ def uncontractedListOrderPos (c : WickContraction n) (i : Fin n.succ) : ℕ := @[simp] lemma uncontractedListOrderPos_le_length (c : WickContraction n) (i : Fin n.succ) : c.uncontractedListOrderPos i ≤ c.uncontractedList.length := by - simp only [uncontractedListOrderPos, Nat.succ_eq_add_one] - have h1 := c.uncontractedList.length_filter_le (fun x => x.1 < i.1) - omega + simpa only [uncontractedListOrderPos] using + c.uncontractedList.length_filter_le fun x => x.1 < i.1 lemma take_uncontractedListOrderPos_eq_filter (c : WickContraction n) (i : Fin n.succ) : (c.uncontractedList.take (c.uncontractedListOrderPos i)) = c.uncontractedList.filter (fun x => x.1 < i.1) := by - nth_rewrite 1 [fin_list_sorted_split c.uncontractedList _ i] + nth_rewrite 1 [fin_list_sorted_split c.uncontractedList (uncontractedList_sorted c) i] simp only [uncontractedListOrderPos, Nat.succ_eq_add_one, List.take_left'] - exact uncontractedList_sorted c lemma take_uncontractedListOrderPos_eq_filter_sort (c : WickContraction n) (i : Fin n.succ) : (c.uncontractedList.take (c.uncontractedListOrderPos i)) = (c.uncontracted.filter (fun x => x.1 < i.1)).sort (· ≤ ·) := by rw [take_uncontractedListOrderPos_eq_filter] - have h1 : (c.uncontractedList.filter (fun x => x.1 < i.1)).Pairwise (· ≤ ·) := by - apply List.Pairwise.filter - exact uncontractedList_sorted c - have h2 : (c.uncontractedList.filter (fun x => x.1 < i.1)).Nodup := by - refine List.Nodup.filter _ ?_ - exact uncontractedList_nodup c - have h3 : (c.uncontractedList.filter (fun x => x.1 < i.1)).toFinset = - (c.uncontracted.filter (fun x => x.1 < i.1)) := by - rw [uncontractedList_eq_sort] - simp - rw [← h3] - exact ((List.toFinset_sort (α := Fin n) (· ≤ ·) h2).mpr h1).symm + exact filter_uncontractedList c fun x => x.1 < i.1 lemma orderedInsert_succAboveEmb_uncontractedList_eq_insertIdx (c : WickContraction n) (i : Fin n.succ) : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)) = (List.map i.succAboveEmb c.uncontractedList).insertIdx (uncontractedListOrderPos c i) i := by - rw [orderedInsert_eq_insertIdx_of_fin_list_sorted] - · congr 1 - simp only [Nat.succ_eq_add_one, Fin.val_fin_lt, Fin.coe_succAboveEmb, uncontractedListOrderPos] - rw [List.filter_map] - simp only [List.length_map] - congr - funext x - simp only [Function.comp_apply, Fin.succAbove, decide_eq_decide] - split - · simp only [Fin.lt_def, Fin.val_castSucc] - · rename_i h - simp_all only [Fin.lt_def, Fin.val_castSucc, not_lt, Fin.val_succ] - omega - · exact uncontractedList_succAboveEmb_sorted c i + rw [orderedInsert_eq_insertIdx_of_fin_list_sorted _ (uncontractedList_succAboveEmb_sorted c i)] + congr 1 + simp only [Nat.succ_eq_add_one, Fin.val_fin_lt, Fin.coe_succAboveEmb, uncontractedListOrderPos] + rw [List.filter_map] + simp only [List.length_map] + congr + funext x + simp only [Function.comp_apply, Fin.succAbove, decide_eq_decide] + split + · simp only [Fin.lt_def, Fin.val_castSucc] + · rename_i h + simp_all only [Fin.lt_def, Fin.val_castSucc, not_lt, Fin.val_succ] + omega end WickContraction diff --git a/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean b/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean index aed41de11..0b1f94138 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean @@ -123,27 +123,16 @@ lemma ext_even (S T : Fin (2 * n.succ) → ℚ) (h1 : ∀ i, S (evenFst i) = T ( (h2 : ∀ i, S (evenSnd i) = T (evenSnd i)) : S = T := by funext i by_cases hi : i.val < n.succ - · let j : Fin n.succ := ⟨i, hi⟩ - have h2 := h1 j - have h3 : evenFst j = i := rfl - rw [h3] at h2 - exact h2 - · let j : Fin n.succ := ⟨i - n.succ, by omega⟩ - have h2 := h2 j - have h3 : evenSnd j = i := by - simp only [succ_eq_add_one, evenSnd, Fin.ext_iff, Fin.val_cast, Fin.val_natAdd, j] + · exact h1 ⟨i, hi⟩ + · have h3 : evenSnd ⟨i - n.succ, by omega⟩ = i := by + simp only [succ_eq_add_one, evenSnd, Fin.ext_iff, Fin.val_cast, Fin.val_natAdd] omega - rw [h3] at h2 - exact h2 + exact h3 ▸ h2 _ lemma sum_even (S : Fin (2 * n.succ) → ℚ) : ∑ i, S i = ∑ i : Fin n.succ, ((S ∘ evenFst) i + (S ∘ evenSnd) i) := by - have h1 : ∑ i, S i = ∑ i : Fin (n.succ + n.succ), S (Fin.cast (split_equal n.succ) i) := by - rw [Finset.sum_equiv (Fin.castOrderIso (split_equal n.succ)).symm.toEquiv] - · intro i - simp only [mem_univ, Fin.symm_castOrderIso, RelIso.coe_fn_toEquiv] - · exact fun _ _=> rfl - rw [h1, Fin.sum_univ_add, Finset.sum_add_distrib] + rw [← Equiv.sum_comp (Fin.castOrderIso (split_equal n.succ)).toEquiv S, Fin.sum_univ_add, + Finset.sum_add_distrib] rfl /-! @@ -181,17 +170,10 @@ lemma sum_evenShift (S : Fin (2 * n.succ) → ℚ) : · intro i simp only [mem_univ, Fin.symm_castOrderIso, RelIso.coe_fn_toEquiv] · exact fun _ _ => rfl - rw [h1] - rw [Fin.sum_univ_add, Fin.sum_univ_add, Fin.sum_univ_add, Finset.sum_add_distrib] - simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] - repeat rw [Rat.add_assoc] - apply congrArg - rw [Rat.add_comm] - rw [← Rat.add_assoc] - nth_rewrite 2 [Rat.add_comm] - repeat rw [Rat.add_assoc] - nth_rewrite 2 [Rat.add_comm] - rfl + rw [h1, Fin.sum_univ_add, Fin.sum_univ_add, Fin.sum_univ_add, Finset.sum_add_distrib] + simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply, + evenShiftZero, evenShiftLast, evenShiftFst, evenShiftSnd] + abel /-! @@ -214,9 +196,7 @@ lemma evenShiftFst_eq_evenFst_succ (j : Fin n) : evenShiftFst j = evenFst j.succ lemma evenShiftSnd_eq_evenSnd_castSucc (j : Fin n) : evenShiftSnd j = evenSnd j.castSucc := by rw [Fin.ext_iff, evenSnd, evenShiftSnd] simp only [Fin.val_cast, Fin.val_natAdd, Fin.val_castAdd, Fin.val_castSucc] - ring_nf - rw [Nat.succ_eq_add_one] - ring + omega /-! @@ -272,8 +252,7 @@ lemma basis_on_evenFst_other {k j : Fin n.succ} (h : k ≠ j) : set_option backward.isDefEq.respectTransparency false in lemma basis_on_other {k : Fin n.succ} {j : Fin (2 * n.succ)} (h1 : j ≠ evenFst k) (h2 : j ≠ evenSnd k) : basisAsCharges k j = 0 := by - simp only [basisAsCharges, succ_eq_add_one] - simp_all only [ne_eq, ↓reduceIte] + simp only [basisAsCharges, if_neg h1, if_neg h2] set_option backward.isDefEq.respectTransparency false in lemma basis_evenSnd_eq_neg_evenFst (j i : Fin n.succ) : @@ -308,10 +287,7 @@ lemma basis_on_evenSnd_other {k j : Fin n.succ} (h : k ≠ j) : basisAsCharges k -/ lemma basis_linearACC (j : Fin n.succ) : (accGrav (2 * n.succ)) (basisAsCharges j) = 0 := by - rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_even] - simp [basis_evenSnd_eq_neg_evenFst] + simp [accGrav, sum_even, basis_evenSnd_eq_neg_evenFst] /-! ### B.4. The basis vectors satisfy the cubic ACC @@ -320,8 +296,7 @@ lemma basis_linearACC (j : Fin n.succ) : (accGrav (2 * n.succ)) (basisAsCharges lemma basis_accCube (j : Fin n.succ) : accCube (2 * n.succ) (basisAsCharges j) = 0 := by rw [accCube_explicit, sum_even] - apply Finset.sum_eq_zero - intro i _ + refine Finset.sum_eq_zero fun i _ => ?_ simp only [succ_eq_add_one, Function.comp_apply, basis_evenSnd_eq_neg_evenFst] ring @@ -357,27 +332,20 @@ def P (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • lemma P_evenFst (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenFst j) = f j := by rw [P, sum_of_charges] simp only [succ_eq_add_one, HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis_on_evenFst_self] - exact Rat.mul_one (f j) - · intro k _ hkj - rw [basis_on_evenFst_other hkj] - exact Rat.mul_zero (f k) - · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] + rw [Fintype.sum_eq_single j] + · simp [basis_on_evenFst_self] + · exact fun k hkj => mul_eq_zero_of_right (f k) (basis_on_evenFst_other hkj) lemma P_evenSnd (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenSnd j) = - f j := by rw [P, sum_of_charges] simp only [succ_eq_add_one, HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · simp only [basis_on_evenSnd_self, mul_neg, mul_one] - · intro k _ hkj - simp only [basis_on_evenSnd_other hkj, mul_zero] - · simp + rw [Fintype.sum_eq_single j] + · simp [basis_on_evenSnd_self] + · exact fun k hkj => mul_eq_zero_of_right (f k) (basis_on_evenSnd_other hkj) lemma P_evenSnd_evenFst (f : Fin n.succ → ℚ) : P f ∘ evenSnd = - P f ∘ evenFst := by funext j - simp only [Function.comp_apply, Pi.neg_apply] - rw [P_evenFst, P_evenSnd] + simp [P_evenFst, P_evenSnd] /-! @@ -386,15 +354,11 @@ lemma P_evenSnd_evenFst (f : Fin n.succ → ℚ) : P f ∘ evenSnd = - P f ∘ e -/ lemma P_linearACC (f : Fin n.succ → ℚ) : (accGrav (2 * n.succ)) (P f) = 0 := by - rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_even] - simp [P_evenSnd, P_evenFst] + simp [accGrav, sum_even, P_evenSnd, P_evenFst] lemma P_accCube (f : Fin n.succ → ℚ) : accCube (2 * n.succ) (P f) = 0 := by rw [accCube_explicit, sum_even] - apply Finset.sum_eq_zero - intro i _ + refine Finset.sum_eq_zero fun i _ => ?_ simp only [succ_eq_add_one, Function.comp_apply, P_evenFst, P_evenSnd] ring @@ -405,10 +369,7 @@ lemma P_accCube (f : Fin n.succ → ℚ) : accCube (2 * n.succ) (P f) = 0 := by -/ lemma P_zero (f : Fin n.succ → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by - intro i - erw [← P_evenFst f] - rw [h] - rfl + exact fun i => (P_evenFst f i).symm.trans (congr_fun h (evenFst i)) /-! @@ -435,12 +396,7 @@ theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by apply Fintype.linearIndependent_iff.mpr intro f h change P' f = 0 at h - have h1 : (P' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P'_val] at h1 - exact P_zero f h1 + exact P_zero f ((P'_val f).symm.trans (congrArg _ h)) /-! @@ -501,27 +457,16 @@ lemma basis!_on_evenShiftFst_self (j : Fin n) : basis!AsCharges j (evenShiftFst set_option backward.isDefEq.respectTransparency false in lemma basis!_on_other {k : Fin n} {j : Fin (2 * n.succ)} (h1 : j ≠ evenShiftFst k) (h2 : j ≠ evenShiftSnd k) : basis!AsCharges k j = 0 := by - simp only [basis!AsCharges, succ_eq_add_one] - simp_all only [ne_eq, ↓reduceIte] + simp only [basis!AsCharges, if_neg h1, if_neg h2] set_option backward.isDefEq.respectTransparency false in lemma basis!_on_evenShiftFst_other {k j : Fin n} (h : k ≠ j) : basis!AsCharges k (evenShiftFst j) = 0 := by - simp only [basis!AsCharges, succ_eq_add_one] - simp only [evenShiftFst, succ_eq_add_one, evenShiftSnd] - split - · rename_i h1 - rw [Fin.ext_iff] at h1 - simp_all - rw [Fin.ext_iff] at h - simp_all - · split - · rename_i h1 h2 - simp_all - rw [Fin.ext_iff] at h2 - simp only [Fin.val_castAdd, Fin.val_addNat] at h2 - omega - · rfl + rw [ne_eq, Fin.ext_iff] at h + refine basis!_on_other ?_ ?_ <;> + simp only [ne_eq, Fin.ext_iff, evenShiftFst, evenShiftSnd, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd] <;> + omega set_option backward.isDefEq.respectTransparency false in lemma basis!_evenShftSnd_eq_neg_evenShiftFst (j i : Fin n) : @@ -555,31 +500,17 @@ lemma basis!_on_evenShiftSnd_other {k j : Fin n} (h : k ≠ j) : set_option backward.isDefEq.respectTransparency false in lemma basis!_on_evenShiftZero (j : Fin n) : basis!AsCharges j evenShiftZero = 0 := by - simp only [basis!AsCharges, succ_eq_add_one] - split<;> rename_i h - · simp only [evenShiftZero, succ_eq_add_one, Fin.isValue, evenShiftFst, Fin.ext_iff, - Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, Fin.val_natAdd] at h + refine basis!_on_other ?_ ?_ <;> + simp only [ne_eq, Fin.ext_iff, evenShiftZero, evenShiftFst, evenShiftSnd, Fin.val_cast, + Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero] <;> omega - · split <;> rename_i h2 - · simp only [evenShiftZero, succ_eq_add_one, Fin.isValue, evenShiftSnd, Fin.ext_iff, - Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, Fin.val_natAdd] at h2 - omega - · rfl set_option backward.isDefEq.respectTransparency false in lemma basis!_on_evenShiftLast (j : Fin n) : basis!AsCharges j evenShiftLast = 0 := by - simp only [basis!AsCharges, succ_eq_add_one] - split <;> rename_i h - · rw [Fin.ext_iff] at h - simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.val_cast, Fin.val_natAdd, - Fin.val_eq_zero, add_zero, evenShiftFst, Fin.val_castAdd, add_right_inj] at h + refine basis!_on_other ?_ ?_ <;> + simp only [ne_eq, Fin.ext_iff, evenShiftLast, evenShiftFst, evenShiftSnd, Fin.val_cast, + Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero, add_zero] <;> omega - · split <;> rename_i h2 - · rw [Fin.ext_iff] at h2 - simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.val_cast, Fin.val_natAdd, - Fin.val_eq_zero, add_zero, evenShiftSnd, Fin.val_castAdd, add_right_inj] at h2 - omega - · rfl /-! @@ -588,10 +519,8 @@ lemma basis!_on_evenShiftLast (j : Fin n) : basis!AsCharges j evenShiftLast = 0 -/ lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n.succ)) (basis!AsCharges j) = 0 := by - rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast] - simp [basis!_evenShftSnd_eq_neg_evenShiftFst] + simp [accGrav, sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast, + basis!_evenShftSnd_eq_neg_evenShiftFst] /-! @@ -605,8 +534,7 @@ lemma basis!_accCube (j : Fin n) : rw [basis!_on_evenShiftLast, basis!_on_evenShiftZero] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, zero_add] - apply Finset.sum_eq_zero - intro i _ + refine Finset.sum_eq_zero fun i _ => ?_ simp only [basis!_evenShftSnd_eq_neg_evenShiftFst] ring @@ -642,32 +570,22 @@ def P! (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • bas lemma P!_evenShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftFst j) = f j := by rw [P!, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_evenShiftFst_self] - exact Rat.mul_one (f j) - · intro k _ hkj - rw [basis!_on_evenShiftFst_other hkj] - exact Rat.mul_zero (f k) - · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] + rw [Fintype.sum_eq_single j] + · simp [basis!_on_evenShiftFst_self] + · exact fun k hkj => mul_eq_zero_of_right (f k) (basis!_on_evenShiftFst_other hkj) lemma P!_evenShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftSnd j) = - f j := by rw [P!, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_evenShiftSnd_self] - exact mul_neg_one (f j) - · intro k _ hkj - rw [basis!_on_evenShiftSnd_other hkj] - exact Rat.mul_zero (f k) - · simp + rw [Fintype.sum_eq_single j] + · simp [basis!_on_evenShiftSnd_self] + · exact fun k hkj => mul_eq_zero_of_right (f k) (basis!_on_evenShiftSnd_other hkj) lemma P!_evenShiftZero (f : Fin n → ℚ) : P! f (evenShiftZero) = 0 := by - rw [P!, sum_of_charges] - simp [HSMul.hSMul, SMul.smul, basis!_on_evenShiftZero] + simp [P!, sum_of_charges, HSMul.hSMul, SMul.smul, basis!_on_evenShiftZero] lemma P!_evenShiftLast (f : Fin n → ℚ) : P! f evenShiftLast = 0 := by - rw [P!, sum_of_charges] - simp [HSMul.hSMul, SMul.smul, basis!_on_evenShiftLast] + simp [P!, sum_of_charges, HSMul.hSMul, SMul.smul, basis!_on_evenShiftLast] /-! @@ -679,8 +597,7 @@ lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (P! f) = 0 := by rw [accCube_explicit, sum_evenShift, P!_evenShiftZero, P!_evenShiftLast] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, zero_add] - apply Finset.sum_eq_zero - intro i _ + refine Finset.sum_eq_zero fun i _ => ?_ simp only [P!_evenShiftFst, P!_evenShiftSnd] ring @@ -691,10 +608,7 @@ lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (P! f) = 0 := by -/ lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by - intro i - rw [← P!_evenShiftFst f] - rw [h] - rfl + exact fun i => (P!_evenShiftFst f i).symm.trans (congr_fun h (evenShiftFst i)) /-! @@ -703,9 +617,7 @@ lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by -/ lemma P!_in_span (f : Fin n → ℚ) : P! f ∈ Submodule.span ℚ (Set.range basis!AsCharges) := by - rw [(Submodule.mem_span_range_iff_exists_fun ℚ)] - use f - rfl + exact (Submodule.mem_span_range_iff_exists_fun ℚ).mpr ⟨f, rfl⟩ /-! @@ -732,12 +644,7 @@ theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by apply Fintype.linearIndependent_iff.mpr intro f h change P!' f = 0 at h - have h1 : (P!' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P!'_val] at h1 - exact P!_zero f h1 + exact P!_zero f ((P!'_val f).symm.trans (congrArg _ h)) /-! @@ -748,10 +655,7 @@ theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by lemma smul_basis!AsCharges_in_span (S : (PureU1 (2 * n.succ)).LinSols) (j : Fin n) : (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j ∈ Submodule.span ℚ (Set.range basis!AsCharges) := by - apply Submodule.smul_mem - apply SetLike.mem_of_subset - · exact Submodule.subset_span - · simp_all only [Set.mem_range, exists_apply_eq_apply] + exact Submodule.smul_mem _ _ (Submodule.subset_span ⟨j, rfl⟩) /-! @@ -789,14 +693,13 @@ lemma P_P_P!_accCube (g : Fin n.succ → ℚ) (j : Fin n) : TriLinearSymm.mk₃_toFun_apply_apply] erw [sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast] simp only [mul_zero, add_zero, Function.comp_apply, zero_add] - rw [Finset.sum_eq_single j, basis!_on_evenShiftFst_self, basis!_on_evenShiftSnd_self] + rw [Fintype.sum_eq_single j, basis!_on_evenShiftFst_self, basis!_on_evenShiftSnd_self] · simp only [evenShiftFst_eq_evenFst_succ, mul_one, evenShiftSnd_eq_evenSnd_castSucc, mul_neg] rw [P_evenFst, P_evenSnd] ring - · intro k _ hkj + · intro k hkj erw [basis!_on_evenShiftFst_other hkj.symm, basis!_on_evenShiftSnd_other hkj.symm] simp only [mul_zero, add_zero] - · simp lemma P_P!_P!_accCube (g : Fin n → ℚ) (j : Fin n.succ) : accCubeTriLinSymm (P! g) (P! g) (basisAsCharges j) @@ -805,13 +708,12 @@ lemma P_P!_P!_accCube (g : Fin n → ℚ) (j : Fin n.succ) : TriLinearSymm.mk₃_toFun_apply_apply] erw [sum_even] simp only [Function.comp_apply] - rw [Finset.sum_eq_single j, basis_on_evenFst_self, basis_on_evenSnd_self] + rw [Fintype.sum_eq_single j, basis_on_evenFst_self, basis_on_evenSnd_self] · simp only [mul_one, mul_neg] ring - · intro k _ hkj + · intro k hkj erw [basis_on_evenFst_other hkj.symm, basis_on_evenSnd_other hkj.symm] simp only [mul_zero, add_zero] - · simp /-! @@ -861,15 +763,13 @@ lemma Pa_evenShiftSnd (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : lemma Pa_evenShitZero (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : Pa f g (evenShiftZero) = f 0 := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftZero, evenShiftZero_eq_evenFst_zero, P_evenFst] - exact Rat.add_zero (f 0) + rw [P!_evenShiftZero, evenShiftZero_eq_evenFst_zero, P_evenFst, add_zero] lemma Pa_evenShiftLast (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : Pa f g (evenShiftLast) = - f (Fin.last n) := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftLast, evenShiftLast_eq_evenSnd_last, P_evenSnd] - exact Rat.add_zero (-f (Fin.last n)) + rw [P!_evenShiftLast, evenShiftLast_eq_evenSnd_last, P_evenSnd, add_zero] /-! @@ -930,21 +830,14 @@ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n) := by apply Fintype.linearIndependent_iff.mpr intro f h change Pa' f = 0 at h - have h1 : (Pa' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl + have h1 : (Pa' f).val = 0 := congrArg _ h rw [Pa'_P'_P!'] at h1 - change (P' (f ∘ Sum.inl)).val + (P!' (f ∘ Sum.inr)).val = 0 at h1 - rw [P!'_val, P'_val] at h1 - change Pa (f ∘ Sum.inl) (f ∘ Sum.inr) = 0 at h1 + simp only [ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] at h1 have hf := Pa_zero (f ∘ Sum.inl) (f ∘ Sum.inr) h1 have hg := Pa_zero! (f ∘ Sum.inl) (f ∘ Sum.inr) h1 - intro i - simp_all - cases i - · simp_all - · simp_all + rintro (i | i) + · exact hf i + · exact hg i /-! ### E.7. Injectivity of the inclusion into linear solutions @@ -960,11 +853,8 @@ lemma Pa'_eq (f f' : (Fin n.succ) ⊕ (Fin n) → ℚ) : Pa' f = Pa' f' ↔ f = rw [h] rw [← Finset.sum_add_distrib] simp - have h2 : ∀ i, (f i + (- f' i)) = 0 := by - exact Fintype.linearIndependent_iff.mp (@basisa_linear_independent n) - (fun i => f i + -f' i) h1 - have h2i := h2 i - linarith + have h2 := Fintype.linearIndependent_iff.mp basisa_linear_independent _ h1 + linarith [h2 i] · rw [h] lemma Pa'_elim_eq_iff (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : diff --git a/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean b/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean index 337937d6f..cdec63a4e 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean @@ -47,19 +47,10 @@ lemma lineInCubic_expand {S : (PureU1 (2 * n.succ)).LinSols} (h : LineInCubic S) intro g f hS a b have h1 := h g f hS a b change accCubeTriLinSymm.toCubic (a • P g + b • P! f) = 0 at h1 - simp only [TriLinearSymm.toCubic_add] at h1 - simp only [HomogeneousCubic.map_smul, + simp only [TriLinearSymm.toCubic_add, HomogeneousCubic.map_smul, accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃] at h1 - conv_lhs at h1 => - enter [1, 1, 1, 2] - change accCube _ _ - rw [P_accCube] - conv_lhs at h1 => - enter [1, 1, 2, 2] - change accCube _ _ - rw [P!_accCube] - rw [← h1] - ring + erw [P_accCube, P!_accCube] at h1 + linear_combination h1 /-- This lemma states that for a given `S` of type `(PureU1 (2 * n.succ)).AnomalyFreeLinear` and @@ -87,13 +78,10 @@ lemma lineInCubicPerm_self {S : (PureU1 (2 * n.succ)).LinSols} lemma lineInCubicPerm_permute {S : (PureU1 (2 * n.succ)).LinSols} (hS : LineInCubicPerm S) (M' : (FamilyPermutations (2 * n.succ)).group) : LineInCubicPerm ((FamilyPermutations (2 * n.succ)).linSolRep M' S) := by - rw [LineInCubicPerm] intro M - change LineInCubic - (((FamilyPermutations (2 * n.succ)).linSolRep M * - (FamilyPermutations (2 * n.succ)).linSolRep M') S) - erw [← (FamilyPermutations (2 * n.succ)).linSolRep.map_mul M M'] - exact hS (M * M') + have h := hS (M * M') + erw [(FamilyPermutations (2 * n.succ)).linSolRep.map_mul M M'] at h + exact h set_option backward.isDefEq.respectTransparency false in lemma lineInCubicPerm_swap {S : (PureU1 (2 * n.succ)).LinSols} @@ -102,17 +90,12 @@ lemma lineInCubicPerm_swap {S : (PureU1 (2 * n.succ)).LinSols} (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) * accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = 0 := by intro j g f h - let S' := (FamilyPermutations (2 * n.succ)).linSolRep - (Equiv.swap (evenShiftFst j) (evenShiftSnd j)) S - have hSS' : ((FamilyPermutations (2 * n.succ)).linSolRep - (Equiv.swap (evenShiftFst j) (evenShiftSnd j))) S = S' := rfl - obtain ⟨g', f', hall⟩ := span_basis_swap! j hSS' g f h + obtain ⟨g', f', hall⟩ := span_basis_swap! j rfl g f h have h1 := line_in_cubic_P_P_P! (lineInCubicPerm_self LIC) g f h have h2 := line_in_cubic_P_P_P! (lineInCubicPerm_self (lineInCubicPerm_permute LIC (Equiv.swap (evenShiftFst j) (evenShiftSnd j)))) g' f' hall.1 - rw [hall.2.1, hall.2.2] at h2 - rw [accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 + rw [hall.2.1, hall.2.2, accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 simpa using h2 lemma P_P_P!_accCube' {S : (PureU1 (2 * n.succ.succ)).LinSols} @@ -121,22 +104,8 @@ lemma P_P_P!_accCube' {S : (PureU1 (2 * n.succ.succ)).LinSols} - (S.val (evenShiftSnd (Fin.last n)) + S.val (evenShiftFst (Fin.last n))) * (2 * S.val evenShiftLast + S.val (evenShiftSnd (Fin.last n)) + S.val (evenShiftFst (Fin.last n))) := by - rw [P_P_P!_accCube f (Fin.last n)] - have h1 := Pa_evenShiftLast f g - have h2 := Pa_evenShiftFst f g (Fin.last n) - have h3 := Pa_evenShiftSnd f g (Fin.last n) - simp only [Fin.succ_last, Nat.succ_eq_add_one] at h1 h2 h3 - have hl : f (Fin.succ (Fin.last n)) = - Pa f g evenShiftLast := by - simp_all only [Fin.succ_last, neg_neg] - erw [hl] at h2 - have hg : g (Fin.last n) = Pa f g (evenShiftFst (Fin.last n)) + Pa f g evenShiftLast := by - linear_combination -(1 * h2) - have hll : f (Fin.castSucc (Fin.last n)) = - - (Pa f g (evenShiftSnd (Fin.last n)) + Pa f g (evenShiftFst (Fin.last n)) - + Pa f g evenShiftLast) := by - linear_combination h3 - 1 * hg - rw [← hS] at hl hll - rw [hl, hll] + rw [P_P_P!_accCube f (Fin.last n), hS, Pa_evenShiftSnd, Pa_evenShiftFst, Pa_evenShiftLast, + Fin.succ_last] ring lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ)).LinSols} @@ -148,13 +117,10 @@ lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ)).LinSols} have h1 := lineInCubicPerm_swap LIC (Fin.last n) g f hfg 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 - · left - linear_combination h1 - · cases h1 <;> rename_i h1 - · refine Or.inr (Or.inl ?_) - linear_combination -(1 * h1) - · exact Or.inr (Or.inr h1) + rcases h1 with h1 | h1 | h1 + · exact Or.inl (by linear_combination h1) + · exact Or.inr (Or.inl (by linear_combination -(1 * h1))) + · exact Or.inr (Or.inr h1) lemma lineInCubicPerm_last_perm {S : (PureU1 (2 * n.succ.succ)).LinSols} (LIC : LineInCubicPerm S) : LineInPlaneCond S := by @@ -163,9 +129,7 @@ lemma lineInCubicPerm_last_perm {S : (PureU1 (2 * n.succ.succ)).LinSols} evenShiftLast ?_ ?_ ?_ ?_ · simp [Fin.ext_iff, evenShiftSnd, evenShiftFst] · simp [Fin.ext_iff, evenShiftSnd, evenShiftLast] - · simp only [Nat.succ_eq_add_one, evenShiftFst, evenShiftLast, Fin.isValue, ne_eq, Fin.ext_iff, - Fin.val_cast, Fin.val_natAdd, Fin.val_castAdd, Fin.val_last, Fin.val_eq_zero, add_zero, - add_right_inj] + · simp [Fin.ext_iff, evenShiftFst, evenShiftLast] omega · exact fun M => lineInCubicPerm_last_cond (lineInCubicPerm_permute LIC M) diff --git a/Physlib/QFT/QED/AnomalyCancellation/LowDim/One.lean b/Physlib/QFT/QED/AnomalyCancellation/LowDim/One.lean index 36e5a26dc..7a495fdb8 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/LowDim/One.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/LowDim/One.lean @@ -25,11 +25,9 @@ namespace One theorem solEqZero (S : (PureU1 1).LinSols) : S = 0 := by apply ACCSystemLinear.LinSols.ext - have hLin := pureU1_linear S - simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton] at hLin funext i - match i with - | ⟨0, _⟩ => exact hLin + rw [Fin.fin_one_eq_zero i, ← Fin.sum_univ_one S.val] + exact pureU1_linear S end One diff --git a/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean b/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean index 90a4b50de..6cc9aa7d9 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean @@ -37,9 +37,8 @@ lemma cube_for_linSol' (S : (PureU1 3).LinSols) : lemma cube_for_linSol (S : (PureU1 3).LinSols) : (S.val (0 : Fin 3) = 0 ∨ S.val (1 : Fin 3) = 0 ∨ S.val (2 : Fin 3) = 0) ↔ (PureU1 3).cubicACC S.val = 0 := by - rw [← cube_for_linSol'] - simp only [Fin.isValue, _root_.mul_eq_zero, OfNat.ofNat_ne_zero, false_or] - exact Iff.symm or_assoc + simp only [← cube_for_linSol', Fin.isValue, _root_.mul_eq_zero, OfNat.ofNat_ne_zero, + false_or, or_assoc] lemma three_sol_zero (S : (PureU1 3).Sols) : S.val (0 : Fin 3) = 0 ∨ S.val (1 : Fin 3) = 0 ∨ S.val (2 : Fin 3) = 0 := (cube_for_linSol S.1.1).mpr S.cubicSol @@ -53,10 +52,8 @@ def solOfLinear (S : (PureU1 3).LinSols) theorem solOfLinear_surjects (S : (PureU1 3).Sols) : ∃ (T : (PureU1 3).LinSols) (hT : T.val (0 : Fin 3) = 0 ∨ T.val (1 : Fin 3) = 0 - ∨ T.val (2 : Fin 3) = 0), solOfLinear T hT = S := by - use S.1.1 - use (three_sol_zero S) - rfl + ∨ T.val (2 : Fin 3) = 0), solOfLinear T hT = S := + ⟨S.1.1, three_sol_zero S, rfl⟩ end Three diff --git a/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean b/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean index b1e743abf..aa1e94187 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean @@ -126,13 +126,9 @@ def oddMid : Fin (2 * n + 1) := lemma sum_odd (S : Fin (2 * n + 1) → ℚ) : ∑ i, S i = S oddMid + ∑ i : Fin n, ((S ∘ oddFst) i + (S ∘ oddSnd) i) := by - have h1 : ∑ i, S i = ∑ i : Fin (n + 1 + n), S (Fin.cast (split_odd n) i) := by - rw [Finset.sum_equiv (Fin.castOrderIso (split_odd n)).symm.toEquiv] - · intro i - simp only [mem_univ, Fin.symm_castOrderIso, RelIso.coe_fn_toEquiv] - · exact fun _ _ => rfl - rw [h1] - rw [Fin.sum_univ_add, Fin.sum_univ_add] + have h1 : ∑ i, S i = ∑ i : Fin (n + 1 + n), S (Fin.cast (split_odd n) i) := + (Equiv.sum_comp (finCongr (split_odd n)) S).symm + rw [h1, Fin.sum_univ_add, Fin.sum_univ_add] simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] nth_rewrite 2 [add_comm] rw [add_assoc] @@ -162,11 +158,8 @@ def oddShiftZero : Fin (2 * n + 1) := lemma sum_oddShift (S : Fin (2 * n + 1) → ℚ) : ∑ i, S i = S oddShiftZero + ∑ i : Fin n, ((S ∘ oddShiftFst) i + (S ∘ oddShiftSnd) i) := by - have h1 : ∑ i, S i = ∑ i : Fin ((1+n)+n), S (Fin.cast (odd_shift_eq n) i) := by - rw [Finset.sum_equiv (Fin.castOrderIso (odd_shift_eq n)).symm.toEquiv] - · intro i - simp only [mem_univ, Fin.castOrderIso, RelIso.coe_fn_toEquiv] - · exact fun _ _ => rfl + have h1 : ∑ i, S i = ∑ i : Fin ((1+n)+n), S (Fin.cast (odd_shift_eq n) i) := + (Equiv.sum_comp (finCongr (odd_shift_eq n)) S).symm rw [h1, Fin.sum_univ_add, Fin.sum_univ_add] simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] rw [add_assoc, Finset.sum_add_distrib] @@ -213,57 +206,52 @@ lemma oddShiftShiftZero_eq_oddShiftZero : @oddShiftShiftZero n = oddShiftZero := lemma oddShiftShiftFst_eq_oddFst_succ (j : Fin n) : oddShiftShiftFst j = oddFst j.succ := by - rw [Fin.ext_iff] - simp only [succ_eq_add_one, oddShiftShiftFst, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, - oddFst, Fin.val_succ] - exact Nat.add_comm 1 ↑j + simp only [Fin.ext_iff, succ_eq_add_one, oddShiftShiftFst, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd, oddFst, Fin.val_succ] + omega lemma oddShiftShiftFst_eq_oddShiftFst_castSucc (j : Fin n) : oddShiftShiftFst j = oddShiftFst j.castSucc := by rfl lemma oddShiftShiftMid_eq_oddMid : @oddShiftShiftMid n = oddMid := by - rw [Fin.ext_iff] - simp only [succ_eq_add_one, oddShiftShiftMid, Fin.isValue, Fin.val_cast, Fin.val_castAdd, - Fin.val_natAdd, Fin.val_eq_zero, add_zero, oddMid] - exact Nat.add_comm 1 n + simp only [Fin.ext_iff, succ_eq_add_one, oddShiftShiftMid, Fin.isValue, Fin.val_cast, + Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero, add_zero, oddMid] + omega lemma oddShiftShiftMid_eq_oddShiftFst_last : oddShiftShiftMid = oddShiftFst (Fin.last n) := by rfl lemma oddShiftShiftSnd_eq_oddSnd (j : Fin n.succ) : oddShiftShiftSnd j = oddSnd j := by - rw [Fin.ext_iff] - simp only [succ_eq_add_one, oddShiftShiftSnd, Fin.val_cast, Fin.val_natAdd, oddSnd, add_left_inj] - exact Nat.add_comm 1 n + simp only [Fin.ext_iff, succ_eq_add_one, oddShiftShiftSnd, Fin.val_cast, Fin.val_natAdd, oddSnd, + add_left_inj] + omega lemma oddShiftShiftSnd_eq_oddShiftSnd (j : Fin n.succ) : oddShiftShiftSnd j = oddShiftSnd j := by rw [Fin.ext_iff] rfl lemma oddSnd_eq_oddShiftSnd (j : Fin n) : oddSnd j = oddShiftSnd j := by - rw [Fin.ext_iff] - simp only [oddSnd, Fin.val_cast, Fin.val_natAdd, oddShiftSnd, add_left_inj] - exact Nat.add_comm n 1 + simp only [Fin.ext_iff, oddSnd, Fin.val_cast, Fin.val_natAdd, oddShiftSnd, add_left_inj] + omega lemma oddShiftZero_eq_oddFst : oddShiftZero = oddFst (0 : Fin n.succ) := by - ext - simp [oddShiftZero, oddFst] + simp [Fin.ext_iff, oddShiftZero, oddFst] lemma oddShiftFst_castSucc_eq_oddFst_succ (j : Fin n) : oddShiftFst j.castSucc = oddFst j.succ := by - rw [Fin.ext_iff] - simp only [oddShiftFst, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, oddFst, Fin.val_succ] - exact Nat.add_comm 1 ↑j + simp only [Fin.ext_iff, oddShiftFst, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, oddFst, + Fin.val_succ, Fin.val_castSucc] + omega lemma oddShiftFst_last_eq_oddMid : oddShiftFst (Fin.last n) = oddMid := by - rw [Fin.ext_iff] - simp only [oddShiftFst, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, oddMid, Fin.val_last] - exact Nat.add_comm 1 n + simp only [Fin.ext_iff, oddShiftFst, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, oddMid, + Fin.val_last] + omega lemma oddShiftSnd_eq_oddSnd (j : Fin n) : oddShiftSnd j = oddSnd j := by - rw [Fin.ext_iff] - simp only [oddShiftSnd, Fin.val_cast, Fin.val_natAdd, oddSnd, add_left_inj] - ring + simp only [Fin.ext_iff, oddShiftSnd, Fin.val_cast, Fin.val_natAdd, oddSnd, add_left_inj] + omega end theDeltas @@ -302,48 +290,26 @@ lemma basis_on_oddFst_self (j : Fin n) : basisAsCharges j (oddFst j) = 1 := by set_option backward.isDefEq.respectTransparency false in lemma basis_on_oddFst_other {k j : Fin n} (h : k ≠ j) : basisAsCharges k (oddFst j) = 0 := by - simp only [basisAsCharges] - simp only [oddFst, oddSnd] + have hk : (k : ℕ) ≠ (j : ℕ) := fun he => h (Fin.ext he) + simp only [basisAsCharges, oddFst, oddSnd, Fin.ext_iff, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd] split - · rename_i h1 - rw [Fin.ext_iff] at h1 - simp_all - rw [Fin.ext_iff] at h - simp_all + · omega · split - · rename_i h1 h2 - simp_all - rw [Fin.ext_iff] at h2 - simp only [Fin.val_castAdd, Fin.val_natAdd] at h2 - omega + · omega · rfl set_option backward.isDefEq.respectTransparency false in lemma basis_on_other {k : Fin n} {j : Fin (2 * n + 1)} (h1 : j ≠ oddFst k) (h2 : j ≠ oddSnd k) : basisAsCharges k j = 0 := by - simp only [basisAsCharges] - simp_all only [ne_eq, ↓reduceIte] + simp only [basisAsCharges, h1, h2, ↓reduceIte] set_option backward.isDefEq.respectTransparency false in lemma basis_oddSnd_eq_minus_oddFst (j i : Fin n) : basisAsCharges j (oddSnd i) = - basisAsCharges j (oddFst i) := by - simp only [basisAsCharges, oddSnd, oddFst] - split <;> split - any_goals split - any_goals split - any_goals rfl - all_goals - rename_i h1 h2 - rw [Fin.ext_iff] at h1 h2 - simp_all only [Fin.cast_inj, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, neg_neg, - add_eq_right, AddLeftCancelMonoid.add_eq_zero, one_ne_zero, and_false, not_false_eq_true] - all_goals - rename_i h3 - rw [Fin.ext_iff] at h3 - simp_all only [Fin.val_natAdd, Fin.val_castAdd, add_eq_right, - AddLeftCancelMonoid.add_eq_zero, one_ne_zero, and_false, not_false_eq_true] - all_goals - omega + simp only [basisAsCharges, oddSnd, oddFst, Fin.ext_iff, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd] + split_ifs <;> first | omega | simp lemma basis_on_oddSnd_self (j : Fin n) : basisAsCharges j (oddSnd j) = - 1 := by rw [basis_oddSnd_eq_minus_oddFst, basis_on_oddFst_self] @@ -354,17 +320,12 @@ lemma basis_on_oddSnd_other {k j : Fin n} (h : k ≠ j) : basisAsCharges k (oddS set_option backward.isDefEq.respectTransparency false in lemma basis_on_oddMid (j : Fin n) : basisAsCharges j oddMid = 0 := by - simp only [basisAsCharges] - split <;> rename_i h - · rw [Fin.ext_iff] at h - simp only [oddMid, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero, - add_zero, oddFst] at h - omega - · split <;> rename_i h2 - · rw [Fin.ext_iff] at h2 - simp only [oddMid, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, - Fin.val_eq_zero, add_zero, oddSnd] at h2 - omega + simp only [basisAsCharges, oddMid, oddFst, oddSnd, Fin.isValue, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd, Fin.val_eq_zero, add_zero, Fin.ext_iff] + split + · omega + · split + · omega · rfl /-! @@ -375,9 +336,7 @@ lemma basis_on_oddMid (j : Fin n) : basisAsCharges j oddMid = 0 := by lemma basis_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basisAsCharges j) = 0 := by rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - erw [sum_odd] - simp [basis_oddSnd_eq_minus_oddFst, basis_on_oddMid] + simp [sum_odd, basis_oddSnd_eq_minus_oddFst, basis_on_oddMid] /-! @@ -411,24 +370,18 @@ def P (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := ∑ i, f i • basis lemma P_oddFst (f : Fin n → ℚ) (j : Fin n) : P f (oddFst j) = f j := by rw [P, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis_on_oddFst_self] - exact Rat.mul_one (f j) - · intro k _ hkj - rw [basis_on_oddFst_other hkj] - exact Rat.mul_zero (f k) - · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] + rw [Fintype.sum_eq_single j] + · simp [basis_on_oddFst_self] + · intro k hkj + exact mul_eq_zero_of_right (f k) (basis_on_oddFst_other hkj) lemma P_oddSnd (f : Fin n → ℚ) (j : Fin n) : P f (oddSnd j) = - f j := by rw [P, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis_on_oddSnd_self] - exact mul_neg_one (f j) - · intro k _ hkj - rw [basis_on_oddSnd_other hkj] - exact Rat.mul_zero (f k) - · simp + rw [Fintype.sum_eq_single j] + · simp [basis_on_oddSnd_self] + · intro k hkj + exact mul_eq_zero_of_right (f k) (basis_on_oddSnd_other hkj) lemma P_oddMid (f : Fin n → ℚ) : P f oddMid = 0 := by rw [P, sum_of_charges] @@ -442,15 +395,12 @@ lemma P_oddMid (f : Fin n → ℚ) : P f oddMid = 0 := by lemma P_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (P f) = 0 := by rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_odd] - simp [P_oddSnd, P_oddFst, P_oddMid] + simp [sum_odd, P_oddSnd, P_oddFst, P_oddMid] lemma P_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P f) = 0 := by rw [accCube_explicit, sum_odd, P_oddMid] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Function.comp_apply, zero_add] - apply Finset.sum_eq_zero - intro i _ + refine Finset.sum_eq_zero fun i _ => ?_ simp only [P_oddFst, P_oddSnd] ring @@ -460,11 +410,8 @@ lemma P_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P f) = 0 := by -/ -lemma P_zero (f : Fin n → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by - intro i - erw [← P_oddFst f] - rw [h] - rfl +lemma P_zero (f : Fin n → ℚ) (h : P f = 0) : ∀ i, f i = 0 := + fun i => (P_oddFst f i).symm.trans (congr_fun h (oddFst i)) /-- A point in the span of the first part of the basis. -/ def P' (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis i @@ -485,12 +432,7 @@ theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by apply Fintype.linearIndependent_iff.mpr intro f h change P' f = 0 at h - have h1 : (P' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P'_val] at h1 - exact P_zero f h1 + exact P_zero f (P'_val f ▸ congrArg ACCSystemLinear.LinSols.val h) /-! @@ -527,46 +469,27 @@ lemma basis!_on_oddShiftFst_self (j : Fin n) : basis!AsCharges j (oddShiftFst j) set_option backward.isDefEq.respectTransparency false in lemma basis!_on_oddShiftFst_other {k j : Fin n} (h : k ≠ j) : basis!AsCharges k (oddShiftFst j) = 0 := by - simp only [basis!AsCharges] - simp only [oddShiftFst, oddShiftSnd] + have hk : (k : ℕ) ≠ (j : ℕ) := fun he => h (Fin.ext he) + simp only [basis!AsCharges, oddShiftFst, oddShiftSnd, Fin.ext_iff, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd] split - · rename_i h1 - rw [Fin.ext_iff] at h1 - simp_all - rw [Fin.ext_iff] at h - simp_all + · omega · split - · rename_i h1 h2 - simp_all - rw [Fin.ext_iff] at h2 - simp only [Fin.val_castAdd, Fin.val_natAdd] at h2 - omega - rfl + · omega + · rfl set_option backward.isDefEq.respectTransparency false in lemma basis!_on_other {k : Fin n} {j : Fin (2 * n + 1)} (h1 : j ≠ oddShiftFst k) (h2 : j ≠ oddShiftSnd k) : basis!AsCharges k j = 0 := by - simp only [basis!AsCharges] - simp_all only [ne_eq, ↓reduceIte] + simp only [basis!AsCharges, h1, h2, ↓reduceIte] set_option backward.isDefEq.respectTransparency false in lemma basis!_oddShiftSnd_eq_minus_oddShiftFst (j i : Fin n) : basis!AsCharges j (oddShiftSnd i) = - basis!AsCharges j (oddShiftFst i) := by - simp only [basis!AsCharges, oddShiftSnd, oddShiftFst] - split <;> split - any_goals split - any_goals split - any_goals rfl - all_goals rename_i h1 h2 - all_goals rw [Fin.ext_iff] at h1 h2 - all_goals simp_all - · subst h1 - exact Fin.elim0 i - all_goals rename_i h3 - all_goals rw [Fin.ext_iff] at h3 - all_goals simp_all - all_goals omega + simp only [basis!AsCharges, oddShiftSnd, oddShiftFst, Fin.ext_iff, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd] + split_ifs <;> first | omega | simp lemma basis!_on_oddShiftSnd_self (j : Fin n) : basis!AsCharges j (oddShiftSnd j) = - 1 := by rw [basis!_oddShiftSnd_eq_minus_oddShiftFst, basis!_on_oddShiftFst_self] @@ -578,17 +501,12 @@ lemma basis!_on_oddShiftSnd_other {k j : Fin n} (h : k ≠ j) : set_option backward.isDefEq.respectTransparency false in lemma basis!_on_oddShiftZero (j : Fin n) : basis!AsCharges j oddShiftZero = 0 := by - simp only [basis!AsCharges] - split <;> rename_i h - · rw [Fin.ext_iff] at h - simp only [oddShiftZero, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, - oddShiftFst, Fin.val_natAdd] at h - omega - · split <;> rename_i h2 - · rw [Fin.ext_iff] at h2 - simp only [oddShiftZero, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, - oddShiftSnd, Fin.val_natAdd] at h2 - omega + simp only [basis!AsCharges, oddShiftZero, oddShiftFst, oddShiftSnd, Fin.isValue, Fin.val_cast, + Fin.val_castAdd, Fin.val_eq_zero, Fin.val_natAdd, Fin.ext_iff] + split + · omega + · split + · omega · rfl /-! @@ -599,9 +517,7 @@ lemma basis!_on_oddShiftZero (j : Fin n) : basis!AsCharges j oddShiftZero = 0 := lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basis!AsCharges j) = 0 := by rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_oddShift, basis!_on_oddShiftZero] - simp [basis!_oddShiftSnd_eq_minus_oddShiftFst] + simp [sum_oddShift, basis!_on_oddShiftZero, basis!_oddShiftSnd_eq_minus_oddShiftFst] /-! @@ -660,24 +576,18 @@ def P! (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := ∑ i, f i • basi lemma P!_oddShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (oddShiftFst j) = f j := by rw [P!, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_oddShiftFst_self] - exact Rat.mul_one (f j) - · intro k _ hkj - rw [basis!_on_oddShiftFst_other hkj] - exact Rat.mul_zero (f k) - · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] + rw [Fintype.sum_eq_single j] + · simp [basis!_on_oddShiftFst_self] + · intro k hkj + exact mul_eq_zero_of_right (f k) (basis!_on_oddShiftFst_other hkj) lemma P!_oddShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (oddShiftSnd j) = - f j := by rw [P!, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_oddShiftSnd_self] - exact mul_neg_one (f j) - · intro k _ hkj - rw [basis!_on_oddShiftSnd_other hkj] - exact Rat.mul_zero (f k) - · simp + rw [Fintype.sum_eq_single j] + · simp [basis!_on_oddShiftSnd_self] + · intro k hkj + exact mul_eq_zero_of_right (f k) (basis!_on_oddShiftSnd_other hkj) lemma P!_oddShiftZero (f : Fin n → ℚ) : P! f oddShiftZero = 0 := by rw [P!, sum_of_charges] @@ -691,15 +601,12 @@ lemma P!_oddShiftZero (f : Fin n → ℚ) : P! f oddShiftZero = 0 := by lemma P!_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (P! f) = 0 := by rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_oddShift] - simp [P!_oddShiftSnd, P!_oddShiftFst, P!_oddShiftZero] + simp [sum_oddShift, P!_oddShiftSnd, P!_oddShiftFst, P!_oddShiftZero] lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P! f) = 0 := by rw [accCube_explicit, sum_oddShift, P!_oddShiftZero] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Function.comp_apply, zero_add] - apply Finset.sum_eq_zero - intro i _ + refine Finset.sum_eq_zero fun i _ => ?_ simp only [P!_oddShiftFst, P!_oddShiftSnd] ring @@ -709,11 +616,8 @@ lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P! f) = 0 := by -/ -lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by - intro i - rw [← P!_oddShiftFst f] - rw [h] - rfl +lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := + fun i => (P!_oddShiftFst f i).symm.trans (congr_fun h (oddShiftFst i)) /-! @@ -740,12 +644,7 @@ theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by apply Fintype.linearIndependent_iff.mpr intro f h change P!' f = 0 at h - have h1 : (P!' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P!'_val] at h1 - exact P!_zero f h1 + exact P!_zero f (P!'_val f ▸ congrArg ACCSystemLinear.LinSols.val h) /-! @@ -759,13 +658,12 @@ lemma P_P_P!_accCube (g : Fin n → ℚ) (j : Fin n) : simp only [accCubeTriLinSymm, TriLinearSymm.mk₃_toFun_apply_apply] erw [sum_oddShift, basis!_on_oddShiftZero] simp only [mul_zero, Function.comp_apply, zero_add] - rw [Finset.sum_eq_single j, basis!_on_oddShiftFst_self, basis!_on_oddShiftSnd_self] + rw [Fintype.sum_eq_single j, basis!_on_oddShiftFst_self, basis!_on_oddShiftSnd_self] · rw [← oddSnd_eq_oddShiftSnd, P_oddSnd] ring - · intro k _ hkj + · intro k hkj erw [basis!_on_oddShiftFst_other hkj.symm, basis!_on_oddShiftSnd_other hkj.symm] simp only [mul_zero, add_zero] - · simp /-! @@ -805,8 +703,7 @@ lemma Pa_oddShiftShiftZero (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftZero simp only [ACCSystemCharges.chargesAddCommMonoid_add] nth_rewrite 1 [oddShiftShiftZero_eq_oddFst_zero] rw [oddShiftShiftZero_eq_oddShiftZero] - rw [P!_oddShiftZero, oddShiftZero_eq_oddFst, P_oddFst] - exact Rat.add_zero (f 0) + rw [P!_oddShiftZero, oddShiftZero_eq_oddFst, P_oddFst, add_zero] lemma Pa_oddShiftShiftFst (f g : Fin n.succ → ℚ) (j : Fin n) : Pa f g (oddShiftShiftFst j) = f j.succ + g j.castSucc := by @@ -821,8 +718,7 @@ lemma Pa_oddShiftShiftMid (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftMid = simp only [ACCSystemCharges.chargesAddCommMonoid_add] nth_rewrite 1 [oddShiftShiftMid_eq_oddMid] rw [oddShiftShiftMid_eq_oddShiftFst_last] - rw [P!_oddShiftFst, oddShiftFst_last_eq_oddMid, P_oddMid] - exact Rat.zero_add (g (Fin.last n)) + rw [P!_oddShiftFst, oddShiftFst_last_eq_oddMid, P_oddMid, zero_add] lemma Pa_oddShiftShiftSnd (f g : Fin n.succ → ℚ) (j : Fin n.succ) : Pa f g (oddShiftShiftSnd j) = - f j - g j := by @@ -891,10 +787,7 @@ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n.succ) := by apply Fintype.linearIndependent_iff.mpr intro f h change Pa' f = 0 at h - have h1 : (Pa' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl + have h1 : (Pa' f).val = 0 := congrArg ACCSystemLinear.LinSols.val h rw [Pa'_P'_P!'] at h1 change (P' (f ∘ Sum.inl)).val + (P!' (f ∘ Sum.inr)).val = 0 at h1 rw [P!'_val, P'_val] at h1 @@ -903,9 +796,7 @@ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n.succ) := by have hg := Pa_zero! (f ∘ Sum.inl) (f ∘ Sum.inr) h1 intro i simp_all only [succ_eq_add_one, Function.comp_apply] - cases i - · simp_all - · simp_all + cases i <;> simp_all /-! @@ -919,15 +810,11 @@ lemma Pa'_eq (f f' : (Fin n.succ) ⊕ (Fin n.succ) → ℚ) : Pa' f = Pa' f' ↔ rw [Pa', Pa'] at h have h1 : ∑ i : Fin n.succ ⊕ Fin n.succ, (f i + (- f' i)) • basisa i = 0 := by simp only [add_smul, neg_smul] - rw [Finset.sum_add_distrib] - rw [h] - rw [← Finset.sum_add_distrib] + rw [Finset.sum_add_distrib, h, ← Finset.sum_add_distrib] simp - have h2 : ∀ i, (f i + (- f' i)) = 0 := by - exact Fintype.linearIndependent_iff.mp (@basisa_linear_independent n) - (fun i => f i + -f' i) h1 - have h2i := h2 i - linarith + have h2 : ∀ i, (f i + (- f' i)) = 0 := + Fintype.linearIndependent_iff.mp (@basisa_linear_independent n) (fun i => f i + -f' i) h1 + linarith [h2 i] · rw [h] lemma Pa'_elim_eq_iff (g g' : Fin n.succ → ℚ) (f f' : Fin n.succ → ℚ) : @@ -955,8 +842,7 @@ lemma Pa_eq (g g' : Fin n.succ → ℚ) (f f' : Fin n.succ → ℚ) : lemma basisa_card : Fintype.card ((Fin n.succ) ⊕ (Fin n.succ)) = Module.finrank ℚ (PureU1 (2 * n.succ + 1)).LinSols := by erw [BasisLinear.finrank_AnomalyFreeLinear] - simp only [Fintype.card_sum, Fintype.card_fin] - exact Eq.symm (Nat.two_mul n.succ) + simp [Fintype.card_sum, Fintype.card_fin, two_mul] /-! @@ -977,13 +863,12 @@ noncomputable def basisaAsBasis : lemma span_basis (S : (PureU1 (2 * n.succ + 1)).LinSols) : ∃ (g f : Fin n.succ → ℚ), S.val = P g + P! f := by - have h := (Submodule.mem_span_range_iff_exists_fun ℚ).mp (Basis.mem_span basisaAsBasis S) - obtain ⟨f, hf⟩ := h + obtain ⟨f, hf⟩ := + (Submodule.mem_span_range_iff_exists_fun ℚ).mp (Basis.mem_span basisaAsBasis S) simp only [succ_eq_add_one, basisaAsBasis, coe_basisOfLinearIndependentOfCardEqFinrank, Fintype.sum_sum_type] at hf change P' _ + P!' _ = S at hf - use f ∘ Sum.inl - use f ∘ Sum.inr + refine ⟨f ∘ Sum.inl, f ∘ Sum.inr, ?_⟩ rw [← hf] simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] rfl @@ -1001,24 +886,15 @@ lemma span_basis_swap! {S : (PureU1 (2 * n.succ + 1)).LinSols} (j : Fin n.succ) S'.val = P g' + P! f' ∧ P! f' = P! f + (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) • basis!AsCharges j ∧ g' = g := by let X := P! f + (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) • basis!AsCharges j - have hf : P! f ∈ Submodule.span ℚ (Set.range basis!AsCharges) := by - rw [(Submodule.mem_span_range_iff_exists_fun ℚ)] - use f - rfl + have hf : P! f ∈ Submodule.span ℚ (Set.range basis!AsCharges) := + (Submodule.mem_span_range_iff_exists_fun ℚ).mpr ⟨f, rfl⟩ have hP : (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) • basis!AsCharges j ∈ - Submodule.span ℚ (Set.range basis!AsCharges) := by - apply Submodule.smul_mem - apply SetLike.mem_of_subset - apply Submodule.subset_span - simp_all only [Set.mem_range, exists_apply_eq_apply] - have hX : X ∈ Submodule.span ℚ (Set.range (basis!AsCharges)) := by - apply Submodule.add_mem - exact hf - exact hP - have hXsum := (Submodule.mem_span_range_iff_exists_fun ℚ).mp hX - obtain ⟨f', hf'⟩ := hXsum - use g - use f' + Submodule.span ℚ (Set.range basis!AsCharges) := + Submodule.smul_mem _ _ (Submodule.subset_span ⟨j, rfl⟩) + have hX : X ∈ Submodule.span ℚ (Set.range (basis!AsCharges)) := + Submodule.add_mem _ hf hP + obtain ⟨f', hf'⟩ := (Submodule.mem_span_range_iff_exists_fun ℚ).mp hX + use g, f' change P! f' = _ at hf' erw [hf'] simp only [and_self, and_true, X] diff --git a/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean b/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean index a2115ba7f..0a8a900a0 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean @@ -49,12 +49,10 @@ lemma lineInCubic_expand {S : (PureU1 (2 * n + 1)).LinSols} (h : LineInCubic S) intro g f hS a b have h1 := h g f hS a b change accCubeTriLinSymm.toCubic (a • P g + b • P! f) = 0 at h1 - simp only [TriLinearSymm.toCubic_add] at h1 - simp only [HomogeneousCubic.map_smul, + simp only [TriLinearSymm.toCubic_add, HomogeneousCubic.map_smul, accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃] at h1 erw [P_accCube, P!_accCube] at h1 - rw [← h1] - ring + linear_combination h1 lemma line_in_cubic_P_P_P! {S : (PureU1 (2 * n + 1)).LinSols} (h : LineInCubic S) : ∀ (g : Fin n → ℚ) (f : Fin n → ℚ) (_ : S.val = P g + P! f), @@ -85,16 +83,11 @@ lemma lineInCubicPerm_swap {S : (PureU1 (2 * n.succ + 1)).LinSols} (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) * accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = 0 := by intro j g f h - let S' := (FamilyPermutations (2 * n.succ + 1)).linSolRep - (Equiv.swap (oddShiftFst j) (oddShiftSnd j)) S - have hSS' : ((FamilyPermutations (2 * n.succ + 1)).linSolRep - (Equiv.swap (oddShiftFst j) (oddShiftSnd j))) S = S' := rfl - obtain ⟨g', f', hall⟩ := span_basis_swap! j hSS' g f h + obtain ⟨g', f', hall⟩ := span_basis_swap! j rfl g f h have h1 := line_in_cubic_P_P_P! (lineInCubicPerm_self LIC) g f h have h2 := line_in_cubic_P_P_P! (lineInCubicPerm_self (lineInCubicPerm_permute LIC (Equiv.swap (oddShiftFst j) (oddShiftSnd j)))) g' f' hall.1 - rw [hall.2.1, hall.2.2] at h2 - rw [accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 + rw [hall.2.1, hall.2.2, accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 simpa using h2 lemma P_P_P!_accCube' {S : (PureU1 (2 * n.succ.succ + 1)).LinSols} @@ -102,11 +95,8 @@ lemma P_P_P!_accCube' {S : (PureU1 (2 * n.succ.succ + 1)).LinSols} accCubeTriLinSymm (P f) (P f) (basis!AsCharges 0) = (S.val (oddShiftFst 0) + S.val (oddShiftSnd 0)) * (2 * S.val oddShiftZero + S.val (oddShiftFst 0) + S.val (oddShiftSnd 0)) := by - rw [P_P_P!_accCube f 0] - rw [← Pa_oddShiftShiftZero f g] - rw [← hS] - have ht : oddShiftFst (0 : Fin n.succ.succ) = oddFst 1 := rfl - nth_rewrite 1 [ht] + rw [P_P_P!_accCube f 0, ← Pa_oddShiftShiftZero f g, ← hS] + nth_rewrite 1 [show oddShiftFst (0 : Fin n.succ.succ) = oddFst 1 from rfl] rw [P_oddFst] have h1 := Pa_oddShiftShiftZero f g have h4 := Pa_oddShiftShiftSnd f g 0 @@ -115,7 +105,7 @@ lemma P_P_P!_accCube' {S : (PureU1 (2 * n.succ.succ + 1)).LinSols} simp only [Nat.succ_eq_add_one, Fin.succ_zero_eq_one, Fin.castSucc_zero] at h2 have h5 : f 1 = S.val (oddShiftShiftFst 0) + S.val oddShiftShiftZero + S.val (oddShiftShiftSnd 0) := by - linear_combination -(1 * h1) - 1 * h4 - 1 * h2 + linear_combination -h1 - h4 - h2 rw [h5, oddShiftShiftSnd_eq_oddShiftSnd, show (oddShiftShiftFst (0 : Fin n.succ)) = oddShiftFst 0 from rfl, oddShiftShiftZero_eq_oddShiftZero] @@ -128,23 +118,16 @@ lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ+1)).LinSols} have h1 := lineInCubicPerm_swap LIC 0 g f hfg 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 - · left - linear_combination h1 - · cases h1 <;> rename_i h1 - · refine Or.inr (Or.inl ?_) - linear_combination h1 - · refine Or.inr (Or.inr ?_) - linear_combination h1 + rcases h1 with h1 | h1 | h1 + · exact Or.inl (by linear_combination h1) + · exact Or.inr (Or.inl (by linear_combination h1)) + · exact Or.inr (Or.inr (by linear_combination h1)) lemma lineInCubicPerm_last_perm {S : (PureU1 (2 * n.succ.succ + 1)).LinSols} - (LIC : LineInCubicPerm S) : LineInPlaneCond S := by - refine @Prop_three (2 * n.succ.succ + 1) LineInPlaneProp S (oddShiftSnd 0) (oddShiftFst 0) - oddShiftZero ?_ ?_ ?_ ?_ - · exact ne_of_beq_false rfl - · exact ne_of_beq_false rfl - · exact ne_of_beq_false rfl - · exact fun M => lineInCubicPerm_last_cond (lineInCubicPerm_permute LIC M) + (LIC : LineInCubicPerm S) : LineInPlaneCond S := + @Prop_three (2 * n.succ.succ + 1) LineInPlaneProp S (oddShiftSnd 0) (oddShiftFst 0) + oddShiftZero (ne_of_beq_false rfl) (ne_of_beq_false rfl) (ne_of_beq_false rfl) + (fun M => lineInCubicPerm_last_cond (lineInCubicPerm_permute LIC M)) lemma lineInCubicPerm_constAbs {S : (PureU1 (2 * n.succ.succ + 1)).LinSols} (LIC : LineInCubicPerm S) : ConstAbs S.val := diff --git a/Physlib/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean b/Physlib/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean index 4248161f9..572918211 100644 --- a/Physlib/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean +++ b/Physlib/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean @@ -101,14 +101,12 @@ notation "𝐋²[" d' "]" => angularMomentumOperatorSqr (d := d') lemma angularMomentumOperatorSqr_apply_fun {d : ℕ} (ψ : 𝓢(Space d, ℂ)) : 𝐋² ψ = (2 : ℂ)⁻¹ • ∑ i, ∑ j, 𝐋 i j (𝐋 i j ψ) := by - dsimp only [angularMomentumOperatorSqr] - simp only [FunLike.coe_sum, FunLike.coe_smul, + simp only [angularMomentumOperatorSqr, FunLike.coe_sum, FunLike.coe_smul, ContinuousLinearMap.coe_comp, Finset.sum_apply, Pi.smul_apply, Function.comp_apply] lemma angularMomentumOperatorSqr_apply {d : ℕ} (ψ : 𝓢(Space d, ℂ)) (x : Space d) : 𝐋² ψ x = (2 : ℂ)⁻¹ * ∑ i, ∑ j, 𝐋 i j (𝐋 i j ψ) x := by - rw [angularMomentumOperatorSqr_apply_fun] - simp only [smul_apply, sum_apply, smul_eq_mul] + simp only [angularMomentumOperatorSqr_apply_fun, smul_apply, sum_apply, smul_eq_mul] /-! @@ -128,8 +126,7 @@ lemma angularMomentumOperatorSqr_apply {d : ℕ} (ψ : 𝓢(Space d, ℂ)) (x : /-- In one dimension the angular momentum operator is trivial. -/ lemma angularMomentumOperator1D_trivial : 𝐋[1] = 0 := by ext i j - fin_cases i, j - simp [angularMomentumOperator_eq_zero] + simp [Subsingleton.elim i j, angularMomentumOperator_eq_zero] /-- The angular momentum (pseudo)scalar operator in two dimensions, `𝐋 ≔ 𝐋₀₁`. -/ def angularMomentumOperator2D : 𝓢(Space 2, ℂ) →L[ℂ] 𝓢(Space 2, ℂ) := 𝐋 0 1 diff --git a/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/Basic.lean b/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/Basic.lean index 06228f6a3..70debf23c 100644 --- a/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/Basic.lean +++ b/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/Basic.lean @@ -117,9 +117,8 @@ scoped notation "𝑅" => resolvent def IsLowerBound (T : H →ₗ.[ℂ] H) (z : ℂ) (c : ℝ) : Prop := ∀ x : T.domain, c * ‖x‖ ≤ ‖T x - z • x‖ lemma isLowerBound_neg {T : H →ₗ.[ℂ] H} {z : ℂ} {c : ℝ} (h : IsLowerBound T z c) : - IsLowerBound (-T) (-z) c := by - intro x - simp only [neg_apply, neg_smul, sub_neg_eq_add, norm_neg_add, h x] + IsLowerBound (-T) (-z) c := + fun x ↦ by simpa [neg_apply, norm_neg_add] using h x lemma isLowerBound_of_right_le {T : H →ₗ.[ℂ] H} {z : ℂ} {c₁ c₂ : ℝ} (hle : c₁ ≤ c₂) (h : IsLowerBound T z c₂) : @@ -138,9 +137,8 @@ lemma isLowerBound_closure obtain ⟨b, hb, hb'⟩ := mem_closure_iff_seq_limit.mp <| hT.graph_closure_eq_closure_graph ▸ T.closure.mem_graph x rw [nhds_prod_eq] at hb' - have hb₁ := hb'.fst.norm.const_mul c - have hb₂ := (hb'.snd.sub <| hb'.fst.const_smul z).norm - refine le_of_tendsto_of_tendsto' hb₁ hb₂ fun n ↦ ?_ + refine le_of_tendsto_of_tendsto' (hb'.fst.norm.const_mul c) + ((hb'.snd.sub <| hb'.fst.const_smul z).norm) fun n ↦ ?_ obtain ⟨y, hy₁, hy₂⟩ := (mem_graph_iff _).mp (hb n) exact hy₁ ▸ hy₂ ▸ h y · rwa [closure_def' hT] @@ -228,9 +226,9 @@ lemma regularityDomain_isOpen (T : H →ₗ.[ℂ] H) : IsOpen T.regularityDomain /-- `T` and `T.closure` have the same regularity domain. -/ lemma regularityDomain_closure (T : H →ₗ.[ℂ] H) : - T.closure.regularityDomain = T.regularityDomain := by - refine eq_of_le_of_ge (regularityDomain_antitone T.le_closure) ?_ - exact fun _ ⟨c, hc, h⟩ ↦ ⟨c, hc, isLowerBound_closure h⟩ + T.closure.regularityDomain = T.regularityDomain := + eq_of_le_of_ge (regularityDomain_antitone T.le_closure) + fun _ ⟨c, hc, h⟩ ↦ ⟨c, hc, isLowerBound_closure h⟩ lemma IsClosable.closure_range_sub_eq_range_closure_sub [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsClosable) {z : ℂ} (hz : z ∈ T.regularityDomain) : @@ -275,9 +273,9 @@ lemma IsClosable.closure_range_sub_eq_range_closure_sub [CompleteSpace H] lemma IsClosed.sub_range_isClosed [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsClosed) {z : ℂ} (hz : z ∈ T.regularityDomain) : - _root_.IsClosed ((T - z • 1).toFun.range : Set H) := by - have hT' : T.closure = T := hT.isClosable.isClosed_iff.mp hT - exact (hT' ▸ hT.isClosable.closure_range_sub_eq_range_closure_sub hz) ▸ isClosed_closure + _root_.IsClosed ((T - z • 1).toFun.range : Set H) := + (hT.isClosable.isClosed_iff.mp hT ▸ + hT.isClosable.closure_range_sub_eq_range_closure_sub hz) ▸ isClosed_closure /-- `(T.closure - z • 1).rangeᗮ = (T† - conj z • 1).ker` -/ lemma IsUnbounded.orthogonal_closure_sub_range [CompleteSpace H] @@ -348,8 +346,7 @@ lemma IsClosed.defectNumber_eq_zero_iff [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsClosed) {z : ℂ} (hz : z ∈ T.regularityDomain) : T.defectNumber z = 0 ↔ (T - z • 1).toFun.range = ⊤ := by haveI := hT.sub_range_isClosed hz -- needed for HasOrthogonalProjection - rw [← orthogonal_eq_bot_iff, ← rank_eq_zero] - exact Iff.rfl + exact rank_eq_zero.trans orthogonal_eq_bot_iff /-- `T` and `T.closure` have the same defect number at points in their regularity domain. -/ lemma defectNumber_closure [CompleteSpace H] @@ -412,8 +409,7 @@ lemma IsClosable.defectNumber_eq_of_mem_ball [CompleteSpace H] {T : H →ₗ.[ · simp [sub_smul, pow_two] rw [inner_sub_left, h', zero_sub, inner_smul_left, norm_neg, norm_mul, norm_conj, mul_assoc] exact mul_le_mul_of_nonneg_left (norm_inner_le_norm _ _) (norm_nonneg _) - · false_or_by_contra -- `z₁ ∉ T.regularityDomain` ⇒ `c ≤ 0` ⇒ `z₂ ∈ ∅` - exact hz₁ ⟨c, lt_of_le_of_lt dist_nonneg h_ball, h⟩ + · exact absurd ⟨c, dist_nonneg.trans_lt h_ball, h⟩ hz₁ /-- The defect number is constant on each connected component of the regularity domain. -/ lemma IsClosable.defectNumber_const [CompleteSpace H] @@ -473,8 +469,7 @@ lemma IsClosable.defectNumber_const [CompleteSpace H] apply h₁' ▸ h₂' rw [← defectNumber_eq_of_mem_ball hT hc_bound (hε_ball h₁)] rw [← defectNumber_eq_of_mem_ball hT hc_bound (hε_ball h₂)] - · false_or_by_contra - exact (mem_empty_iff_false z₂).mp (connectedComponentIn_eq_empty hz₁ ▸ hz) + · exact ((mem_empty_iff_false z₂).mp (connectedComponentIn_eq_empty hz₁ ▸ hz)).elim /-! ## C. Numerical range @@ -496,8 +491,7 @@ lemma mem_numericalRange {T : H →ₗ.[ℂ] H} {x : T.domain} (hx : x ≠ 0) : lemma numericalRange_nonempty {T : H →ₗ.[ℂ] H} (hT : T.domain ≠ ⊥) : (Θ T).Nonempty := by obtain ⟨x, hx, hx'⟩ := exists_mem_ne_zero_of_ne_bot hT - use (‖x‖ ^ 2)⁻¹ * ⟪x, T ⟨x, hx⟩⟫_ℂ - exact mem_numericalRange (x := ⟨x, hx⟩) (Subtype.coe_ne_coe.mp hx') + exact ⟨_, mem_numericalRange (x := ⟨x, hx⟩) (Subtype.coe_ne_coe.mp hx')⟩ @[simp] lemma numericalRange_neg (T : H →ₗ.[ℂ] H) : Θ (-T) = -Θ T := by @@ -669,9 +663,7 @@ lemma mem_resolventSet_iff {T : H →ₗ.[ℂ] H} {z : ℂ} : /-- If an operator is not closed then its resolvent set is empty. -/ lemma resolventSet_eq_empty [CompleteSpace H] {T : H →ₗ.[ℂ] H} (h : ¬T.IsClosed) : ρ T = ∅ := by - ext z - simp only [mem_empty_iff_false, iff_false] - by_contra ⟨h_ker, h_range, h_cont⟩ + refine eq_empty_iff_forall_notMem.mpr fun z ⟨h_ker, h_range, h_cont⟩ ↦ ?_ suffices (T - z • 1).IsClosed by have hTz : T - z • 1 + z • 1 = T := eq_of_le_of_domain_eq (sub_add_le_cancel _ _) (by simp [add_domain, sub_domain]) @@ -700,12 +692,10 @@ lemma IsClosed.resolventSet_eq [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T. lemma IsClosed.resolventSet_eq' [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsClosed) : ρ T = T.regularityDomain ∩ T.defectNumber ⁻¹' {0} := by ext z - constructor - · intro hρ - have hz : z ∈ T.regularityDomain := T.resolventSet_subset_regularityDomain hρ + refine ⟨fun hρ ↦ ?_, fun ⟨h_reg, h_defect⟩ ↦ ?_⟩ + · have hz : z ∈ T.regularityDomain := T.resolventSet_subset_regularityDomain hρ exact ⟨hz, (hT.defectNumber_eq_zero_iff hz).mpr hρ.2.1⟩ - · intro ⟨h_reg, h_defect⟩ - obtain ⟨h_ker, h_cont⟩ := mem_regularityDomain_iff.mp h_reg + · obtain ⟨h_ker, h_cont⟩ := mem_regularityDomain_iff.mp h_reg exact ⟨h_ker, (hT.defectNumber_eq_zero_iff h_reg).mp h_defect, h_cont⟩ /-- The resolvent set is an open subset of ℂ. -/ @@ -739,8 +729,7 @@ lemma spectrum_eq (T : H →ₗ.[ℂ] H) : σ T = (ρ T)ᶜ := rfl lemma mem_spectrum_iff {T : H →ₗ.[ℂ] H} {z : ℂ} : z ∈ σ T ↔ (T - z • 1).toFun.ker ≠ ⊥ ∨ (T - z • 1).toFun.range ≠ ⊤ ∨ ¬Continuous (𝑅 T z) := by - rw [spectrum_eq, mem_compl_iff, mem_resolventSet_iff] - tauto + simp only [spectrum_eq, mem_compl_iff, mem_resolventSet_iff, not_and_or, ne_eq] /-- If an operator is not closed then its spectrum is all of ℂ. -/ lemma spectrum_eq_univ [CompleteSpace H] {T : H →ₗ.[ℂ] H} (h : ¬T.IsClosed) : σ T = univ := @@ -842,10 +831,8 @@ lemma IsClosed.spectrum_eq [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsCl · refine union_subset ?_ T.continuousSpectrum_subset_spectrum exact union_subset T.pointSpectrum_subset_spectrum T.residualSpectrum_subset_spectrum -lemma pointSpectrum_inter_residualSpectrum (T : H →ₗ.[ℂ] H) : σᵖ T ∩ σʳ T = ∅ := by - ext - simp only [mem_inter_iff, mem_empty_iff_false, iff_false, not_and] - exact fun h h' ↦ h h'.1 +lemma pointSpectrum_inter_residualSpectrum (T : H →ₗ.[ℂ] H) : σᵖ T ∩ σʳ T = ∅ := + eq_empty_iff_forall_notMem.mpr fun _ ⟨h, h'⟩ ↦ h h'.1 /-! ## E. Resolvent identities diff --git a/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SelfAdjoint.lean b/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SelfAdjoint.lean index 061313155..cf58f057d 100644 --- a/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SelfAdjoint.lean +++ b/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SelfAdjoint.lean @@ -53,10 +53,8 @@ lemma resolventSet_eq_regularityDomain : ρ T = T.regularityDomain := by have h_ker' : (T - conj z • 1).toFun.ker = ⊥ := by by_cases hz' : conj z = z · exact hz'.symm ▸ h_ker - · suffices conj z ∉ σᵖ T by simp_all [pointSpectrum_eq] - refine fun h ↦ hz' ?_ - obtain ⟨r, hr⟩ := (isSymmetric hT).pointSpectrum_real h - simp [show z = conj (↑r) from by simp [hr]] + · exact (mem_regularityDomain_iff.mp <| (isSymmetric hT).mem_regularityDomain_of_im_ne_zero + (by simp_all [Complex.conj_eq_iff_im])).1 have h_orthog := (isUnbounded hT).orthogonal_adjoint_sub_ker hz rw [isSelfAdjoint_def.mp hT, (isClosed hT).closure_eq, h_ker'] at h_orthog simp [← h_orthog] @@ -68,11 +66,9 @@ lemma mem_resolventSet_of_range_eq_top {z : ℂ} (h : (T - z • 1).toFun.range · rw [(isClosed hT).resolventSet_eq] refine ⟨?_, h⟩ have h_orthog := (isUnbounded hT).orthogonal_closure_sub_range z - rw [isSelfAdjoint_def.mp hT, (isClosed hT).closure_eq, conj_eq_iff_im.mpr hz_im, h, - Submodule.top_orthogonal_eq_bot, Eq.comm, Submodule.ext_iff] at h_orthog - ext x - specialize h_orthog x - simp_all + rwa [isSelfAdjoint_def.mp hT, (isClosed hT).closure_eq, conj_eq_iff_im.mpr hz_im, h, + Submodule.top_orthogonal_eq_bot, Eq.comm, ← LinearMap.le_ker_iff_map, Submodule.ker_subtype, + le_bot_iff] at h_orthog · rw [resolventSet_eq_regularityDomain hT] exact (isSymmetric hT).mem_regularityDomain_of_im_ne_zero hz_im @@ -86,11 +82,9 @@ lemma spectrum_real : σ T ⊆ range ofReal := by exact compl_subset_comm.mp (isSymmetric hT).compl_ofReal_subset_regularityDomain /-- The residual spectrum of a self-adjoint operator is empty. -/ -lemma residualSpectrum_eq_empty : σʳ T = ∅ := by - apply eq_empty_of_subset_empty - refine inter_compl_self (ρ T) ▸ subset_inter ?_ ?_ - · exact resolventSet_eq_regularityDomain hT ▸ T.residualSpectrum_subset_regularityDomain - · exact T.spectrum_eq ▸ T.residualSpectrum_subset_spectrum +lemma residualSpectrum_eq_empty : σʳ T = ∅ := + eq_empty_iff_forall_notMem.mpr fun _ hz ↦ T.residualSpectrum_subset_spectrum hz + (resolventSet_eq_regularityDomain hT ▸ T.residualSpectrum_subset_regularityDomain hz) end IsSelfAdjoint end LinearPMap diff --git a/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SpectralMeasure.lean b/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SpectralMeasure.lean index 0e4e1ba2b..40933eafa 100644 --- a/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SpectralMeasure.lean +++ b/Physlib/QuantumMechanics/DDimensions/Operators/SpectralTheory/SpectralMeasure.lean @@ -47,9 +47,8 @@ open Set instance (H : Type*) [SeminormedAddCommGroup H] [InnerProductSpace ℂ H] : IsAddTorsionFree (H →L[ℂ] H) where nsmul_right_injective n hn := by - refine Function.HasLeftInverse.injective ?_ - use fun f ↦ (n : ℂ)⁻¹ • f - intro; ext; simp [← Nat.cast_smul_eq_nsmul ℂ, smul_smul, Nat.cast_ne_zero (R := ℂ), hn] + refine Function.HasLeftInverse.injective ⟨fun f ↦ (n : ℂ)⁻¹ • f, fun x ↦ ?_⟩ + simp [← Nat.cast_smul_eq_nsmul ℂ, smul_smul, Nat.cast_ne_zero (R := ℂ), hn] /-! ## A. Definition @@ -95,27 +94,23 @@ lemma comp_of_disjoint {A B : Set α} (h : Disjoint A B) (hA : MeasurableSet A) (hB : MeasurableSet B) : μS A ∘L μS B = 0 := by suffices μS A ∘L μS (A ∪ B) = μS A by simp_all [μS.of_union] - refine (IsStarProjection.sub_iff_mul_eq_left ?_ ?_).mp ?_ - · exact μS.isStarProjection A - · exact μS.isStarProjection (A ∪ B) - · rw [μS.of_union h hA hB, add_sub_cancel_left] - exact μS.isStarProjection B + refine (IsStarProjection.sub_iff_mul_eq_left (μS.isStarProjection A) + (μS.isStarProjection (A ∪ B))).mp ?_ + simpa [μS.of_union h hA hB] using μS.isStarProjection B lemma comp_eq_of_inter {A B : Set α} (hA : MeasurableSet A) (hB : MeasurableSet B) : μS A ∘L μS B = μS (A ∩ B) := by nth_rw 1 [← inter_union_sdiff B A, ← inter_union_sdiff A B] simp only [μS.of_union, hA.inter hB, hB.inter hA, hA.diff hB, hB.diff hA, disjoint_sdiff_inter.symm, add_comp, comp_add] - rw [inter_comm B A, μS.comp_of_disjoint disjoint_sdiff_inter (hA.diff hB) (hA.inter hB)] - rw [inter_comm A B, μS.comp_of_disjoint disjoint_sdiff_inter.symm (hB.inter hA) (hB.diff hA)] + rw [inter_comm B A, μS.comp_of_disjoint disjoint_sdiff_inter (hA.diff hB) (hA.inter hB), + inter_comm A B, μS.comp_of_disjoint disjoint_sdiff_inter.symm (hB.inter hA) (hB.diff hA)] simp [μS.comp_of_disjoint disjoint_sdiff_sdiff (hA.diff hB) (hB.diff hA)] lemma commute (A B : Set α) : Commute (μS A) (μS B) := by by_cases hAB : MeasurableSet A ∧ MeasurableSet B · simp [commute_iff_eq, mul_def, comp_eq_of_inter, hAB, inter_comm] - · rcases not_and_or.mp hAB with hA | hB - · simp [hA] - · simp [hB] + · rcases not_and_or.mp hAB with hA | hB <;> simp [*] end SpectralMeasure diff --git a/Physlib/QuantumMechanics/DDimensions/Operators/Unbounded.lean b/Physlib/QuantumMechanics/DDimensions/Operators/Unbounded.lean index b228fd9a0..accf6b4da 100644 --- a/Physlib/QuantumMechanics/DDimensions/Operators/Unbounded.lean +++ b/Physlib/QuantumMechanics/DDimensions/Operators/Unbounded.lean @@ -154,12 +154,11 @@ lemma closure_domain_le_domain_closure (U : H →ₗ.[ℂ] H') : U.closure.domai · intro ψ hψ obtain ⟨φ, hψφ⟩ := h_cl.graph_closure_eq_closure_graph ▸ mem_domain_iff.mp hψ obtain ⟨b, hb, hb'⟩ := mem_closure_iff_seq_limit.mp hψφ - apply mem_closure_iff_seq_limit.mpr - refine ⟨fun n ↦ (b n).1, fun n ↦ ?_, (nhds_prod_eq (x := ψ) (y := φ) ▸ hb').fst⟩ - specialize hb n + refine mem_closure_iff_seq_limit.mpr + ⟨fun n ↦ (b n).1, fun n ↦ ?_, (nhds_prod_eq (x := ψ) (y := φ) ▸ hb').fst⟩ simp only [coe_toAddSubmonoid, SetLike.mem_coe, mem_graph_iff, Subtype.exists, exists_and_left, exists_eq_left] at hb - exact hb.choose + exact (hb n).choose · simp [closure_def' h_cl, closure_le.mp] lemma hasDenseDomain_iff_closure_hasDenseDomain : U.HasDenseDomain ↔ U.closure.HasDenseDomain := @@ -230,10 +229,7 @@ lemma isClosable_of_exists_dense_formalAdjoint [CompleteSpace H] [CompleteSpace U.IsClosable := by have h_adj : U†.HasDenseDomain := by obtain ⟨U', hU', hU''⟩ := h_fadj - refine Dense.mono ?_ hU' - rcases eq_or_lt_of_le (hU''.symm.le_adjoint h) with (rfl | h_lt) - · rfl - · exact (domain_mono h_lt).le + exact hU'.mono (hU''.symm.le_adjoint h).1 use U†† ext rw [adjoint_graph_eq_graph_adjoint h_adj, adjoint_graph_eq_graph_adjoint h, @@ -312,8 +308,7 @@ lemma adjoint_of_zero [CompleteSpace H] (h_zero : ⇑U = 0) : U† = 0 := by refine dExt ?_ fun x y hxy ↦ ?_ · ext simp only [zero_domain, mem_top, iff_true] - apply (mem_adjoint_domain_iff _ _).mpr - exact continuous_of_const (by simp [h_zero]) + exact (mem_adjoint_domain_iff _ _).mpr (continuous_of_const (by simp [h_zero])) · by_cases h : U.HasDenseDomain · exact adjoint_apply_eq h x (by simp [h_zero]) · exact adjoint_apply_of_not_dense h x @@ -361,9 +356,7 @@ lemma adjoint_add_le_add_adjoint [CompleteSpace H] have h₂ : U₂.HasDenseDomain := h₁₂.mono Set.inter_subset_right constructor · intro u hu - apply mem_adjoint_domain_of_exists - use U₁† ⟨u, hu.1⟩ + U₂† ⟨u, hu.2⟩ - intro x + refine mem_adjoint_domain_of_exists _ ⟨U₁† ⟨u, hu.1⟩ + U₂† ⟨u, hu.2⟩, fun x ↦ ?_⟩ simp only [add_apply, inner_add_left, inner_add_right, adjoint_isFormalAdjoint h₁ ⟨u, hu.1⟩ ⟨x, x.2.1⟩, adjoint_isFormalAdjoint h₂ ⟨u, hu.2⟩ ⟨x, x.2.2⟩] @@ -388,9 +381,8 @@ lemma adjoint_compRestricted_le_compRestricted_adjoint [CompleteSpace H] [Comple trans ⟪V† ⟨x, x.2.2⟩, U ⟨y, y.2.2⟩⟫_ℂ · exact adjoint_isFormalAdjoint hU ⟨V† ⟨x, x.2.2⟩, hx⟩ ⟨y, y.2.2⟩ exact adjoint_isFormalAdjoint hV ⟨x, x.2.2⟩ ⟨U ⟨y, y.2.2⟩, hy⟩ - constructor - · exact fun x hx ↦ mem_adjoint_domain_of_exists _ ⟨(U† ∘ᵣ V†) ⟨x, hx⟩, h ⟨x, hx⟩⟩ - · exact fun x y hxy ↦ (adjoint_apply_eq hVU y <| hxy ▸ h x).symm + exact ⟨fun x hx ↦ mem_adjoint_domain_of_exists _ ⟨(U† ∘ᵣ V†) ⟨x, hx⟩, h ⟨x, hx⟩⟩, + fun x y hxy ↦ (adjoint_apply_eq hVU y <| hxy ▸ h x).symm⟩ lemma adjoint_pow_le_pow_adjoint [CompleteSpace H] {n : ℕ} (h : (T ^ n).HasDenseDomain) : T† ^ n ≤ (T ^ n)† := by @@ -422,8 +414,7 @@ lemma isClosable_of_continuous (h : Continuous U) : U.IsClosable := by refine (toLinearPMap_graph_eq _ fun x hx hx₁ ↦ ?_).symm obtain ⟨b, hb, hbx⟩ := mem_closure_iff_seq_limit.mp hx rw [nhds_prod_eq] at hbx - apply norm_eq_zero.mp - apply tendsto_nhds_unique hbx.snd.norm + refine norm_eq_zero.mp (tendsto_nhds_unique hbx.snd.norm ?_) obtain ⟨M, hM, h_bound⟩ := LinearMap.continuous_iff_bounded.mp h refine squeeze_zero (g := fun n ↦ M * ‖(b n).1‖) (fun _ ↦ norm_nonneg _) (fun n ↦ ?_) ?_ · obtain ⟨y, hy₁, hy₂⟩ := (mem_graph_iff _).mp (hb n) @@ -453,8 +444,7 @@ lemma closure_domain_eq_domain_closure_of_continuous [CompleteSpace H'] (h : Con apply mem_domain_iff.mpr rw [← (isClosable_of_continuous h).graph_closure_eq_closure_graph] use y - apply mem_closure_iff_seq_limit.mpr - refine ⟨fun n ↦ (b n, Ub n), fun n ↦ ?_, ?_⟩ + refine mem_closure_iff_seq_limit.mpr ⟨fun n ↦ (b n, Ub n), fun n ↦ ?_, ?_⟩ · simp [hb n, Ub] · rw [nhds_prod_eq] exact Filter.Tendsto.prodMk hb' hy @@ -478,8 +468,8 @@ lemma IsClosed.isClosed_toFun_graph (hU : U.IsClosed) : obtain ⟨b, hb, hbx⟩ := mem_closure_iff_seq_limit.mp hx apply mem_closure_iff_seq_limit.mpr rw [nhds_prod_eq] at * - refine ⟨fun n ↦ (↑(b n).1, (b n).2), by simp_all, ?_⟩ - exact Filter.Tendsto.prodMk (tendsto_subtype_rng.mp hbx.fst) hbx.snd + refine ⟨fun n ↦ (↑(b n).1, (b n).2), by simp_all, + Filter.Tendsto.prodMk (tendsto_subtype_rng.mp hbx.fst) hbx.snd⟩ /-- The **closed graph theorem** for partial linear maps: a closed operator with closed domain is continuous. @@ -489,9 +479,8 @@ lemma IsClosed.isClosed_toFun_graph (hU : U.IsClosed) : lemma IsClosed.continuous_of_isClosed_domain [CompleteSpace H] [CompleteSpace H'] (hU : U.IsClosed) (h : _root_.IsClosed (U.domain : Set H)) : Continuous U := by - have hCS : CompleteSpace U.domain := instCompleteSpaceSubtypeMemSubmoduleOfIsClosedCoe U.domain - refine @LinearMap.continuous_of_isClosed_graph _ _ _ _ _ hCS _ _ _ _ U.toFun ?_ - exact hU.isClosed_toFun_graph + haveI : CompleteSpace U.domain := instCompleteSpaceSubtypeMemSubmoduleOfIsClosedCoe U.domain + exact LinearMap.continuous_of_isClosed_graph U.toFun hU.isClosed_toFun_graph /-- Closability is preserved upon adding a continuous operator. -/ lemma IsClosable.add_continuous @@ -521,8 +510,7 @@ lemma IsClosable.sub_continuous lemma IsClosed.add_continuous [CompleteSpace H'] (h₁ : U₁.IsClosed) (h₂ : Continuous U₂) (h : U₁.domain ≤ U₂.domain) : (U₁ + U₂).IsClosed := by have hcl : (U₁ + U₂).IsClosable := h₁.isClosable.add_continuous h₂ h - apply hcl.isClosed_iff.mpr - refine eq_of_le_of_ge (le_of_le_graph ?_) (U₁ + U₂).le_closure + refine hcl.isClosed_iff.mpr (eq_of_le_of_ge (le_of_le_graph ?_) (U₁ + U₂).le_closure) rw [← hcl.graph_closure_eq_closure_graph] intro ⟨x₁, x₂⟩ hx obtain ⟨b, hb, hbx⟩ := mem_closure_iff_seq_limit.mp hx @@ -590,8 +578,7 @@ theorem inner_map_polarization' (x y : T.domain) : lemma isSymmetric_iff_inner_map_self_real : T.IsSymmetric ↔ ∀ x : T.domain, conj ⟪T x, x⟫_ℂ = ⟪T x, x⟫_ℂ := by refine ⟨fun h_symm x ↦ by simp [h_symm x x], fun h_re x y ↦ ?_⟩ - nth_rw 2 [← inner_conj_symm] - nth_rw 2 [inner_map_polarization] + nth_rw 2 [← inner_conj_symm, inner_map_polarization] simp only [map_div₀, _root_.map_sub, _root_.map_add, map_mul, neg_mul, conj_ofNat, conj_I, h_re] rw [inner_map_polarization'] simp [sub_eq_add_neg] @@ -620,10 +607,8 @@ lemma add_adjoint_isSymmetric [CompleteSpace H] (h : T.HasDenseDomain) : (T + T.adjoint).IsSymmetric := by intro x y have h₁ := adjoint_isFormalAdjoint h ⟨x, x.2.2⟩ ⟨y, y.2.1⟩ - have h₂ := adjoint_isFormalAdjoint h ⟨y, y.2.2⟩ ⟨x, x.2.1⟩ - apply starRingEquiv.apply_eq_iff_eq.mpr at h₂ - simp only [RingEquiv.toEquiv_eq_coe, EquivLike.coe_coe, starRingEquiv_apply, RCLike.star_def, - inner_conj_symm, MulOpposite.op_inj] at h₂ + have h₂ := congrArg conj (adjoint_isFormalAdjoint h ⟨y, y.2.2⟩ ⟨x, x.2.1⟩) + simp only [inner_conj_symm] at h₂ simp only [add_apply, inner_add_left, inner_add_right, h₁, h₂] exact add_comm _ _ @@ -649,9 +634,8 @@ lemma IsSymmetric.neg (h : T.IsSymmetric) : (-T).IsSymmetric := fun x y ↦ by s @[aesop safe apply] lemma IsSymmetric.add (h₁ : T₁.IsSymmetric) (h₂ : T₂.IsSymmetric) : (T₁ + T₂).IsSymmetric := by intro x y - specialize h₁ ⟨x, x.2.1⟩ ⟨y, y.2.1⟩ - specialize h₂ ⟨x, x.2.2⟩ ⟨y, y.2.2⟩ - simp [h₁, h₂, add_apply, inner_add_left, inner_add_right] + simp [h₁ ⟨x, x.2.1⟩ ⟨y, y.2.1⟩, h₂ ⟨x, x.2.2⟩ ⟨y, y.2.2⟩, add_apply, inner_add_left, + inner_add_right] @[aesop safe apply] lemma IsSymmetric.sub (h₁ : T₁.IsSymmetric) (h₂ : T₂.IsSymmetric) : (T₁ - T₂).IsSymmetric := @@ -742,10 +726,9 @@ lemma IsEssentiallySelfAdjoint.isUnbounded [CompleteSpace H] (h : T.IsEssentiall lemma IsEssentiallySelfAdjoint.unique_self_adjoint_extension [CompleteSpace H] (h : T.IsEssentiallySelfAdjoint) {T₂ : H →ₗ.[ℂ] H} (h_le : T ≤ T₂) (h₂ : IsSelfAdjoint T₂) : T₂ = T.closure := by - have h_dense : T.HasDenseDomain := h.hasDenseDomain have h_cl : T₂.IsClosed := IsSelfAdjoint.isClosed h₂ have h_le' : T.closure ≤ T₂ := h_cl.closure_eq ▸ h_cl.isClosable.closure_mono h_le - exact eq_of_le_of_ge (h ▸ h₂ ▸ adjoint_antitone (Or.inl <| h_dense.closure) h_le') h_le' + exact eq_of_le_of_ge (h ▸ h₂ ▸ adjoint_antitone (Or.inl h.hasDenseDomain.closure) h_le') h_le' @[aesop safe apply] lemma IsEssentiallySelfAdjoint.smul [CompleteSpace H] @@ -781,8 +764,7 @@ lemma IsUnbounded.adjoint [CompleteSpace H] [CompleteSpace H'] (h : U.IsUnbounde rw [← orthogonal_eq_top_iff, orthogonal_orthogonal_eq_closure] exact fun a ↦ ne_of_mem_of_not_mem' mem_top hy a.symm obtain ⟨x, hx, hx'⟩ := exists_mem_ne_zero_of_ne_bot h_ne_bot - apply hx' - refine graph_fst_eq_zero_snd U.closure ?_ rfl + refine hx' (graph_fst_eq_zero_snd U.closure ?_ rfl) rw [← IsClosable.graph_closure_eq_closure_graph h.2, mem_submodule_closure_iff_mem_submoduleToLp_closure, ← orthogonal_orthogonal_eq_closure, ← mem_submodule_adjoint_adjoint_iff_mem_submoduleToLp_orthogonal_orthogonal, diff --git a/Physlib/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean b/Physlib/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean index cad8985c9..265c5192c 100644 --- a/Physlib/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean +++ b/Physlib/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean @@ -42,10 +42,8 @@ lemma planewaveFunctional_apply (k : ℝ) (ψ : 𝓢(ℝ, ℂ)) : all applications of `planewaveFunctional`. -/ lemma eq_of_eq_planewaveFunctional {ψ1 ψ2 : 𝓢(ℝ, ℂ)} (h : ∀ k, planewaveFunctional k ψ1 = planewaveFunctional k ψ2) : - ψ1 = ψ2 := by - apply (FourierTransform.fourierCLE ℂ 𝓢(ℝ, ℂ)).injective - ext k - exact h k + ψ1 = ψ2 := + (FourierTransform.fourierCLE ℂ 𝓢(ℝ, ℂ)).injective (SchwartzMap.ext h) end HilbertSpace end diff --git a/Physlib/QuantumMechanics/OneDimension/Operators/Commutation.lean b/Physlib/QuantumMechanics/OneDimension/Operators/Commutation.lean index ea9dc1955..730d55ae3 100644 --- a/Physlib/QuantumMechanics/OneDimension/Operators/Commutation.lean +++ b/Physlib/QuantumMechanics/OneDimension/Operators/Commutation.lean @@ -37,29 +37,23 @@ lemma positionOperatorSchwartz_commutation_momentumOperatorSchwartz ext x simp [momentumOperatorSchwartz_apply, positionOperatorSchwartz_apply, positionOperatorSchwartz_apply_fun] - rw [deriv_fun_mul] - have h1 : deriv Complex.ofReal x = 1 := by - change deriv Complex.ofRealCLM x = _ - simp - rw [h1] + have h1 : deriv Complex.ofReal x = 1 := Complex.ofRealCLM.deriv.trans (by simp) + rw [deriv_fun_mul, h1] ring - · change DifferentiableAt ℝ Complex.ofRealCLM x - fun_prop - · exact SchwartzMap.differentiableAt ψ + · exact Complex.ofRealCLM.differentiableAt + · exact ψ.differentiableAt lemma positionOperatorSchwartz_momentumOperatorSchwartz_eq (ψ : 𝓢(ℝ, ℂ)) : positionOperatorSchwartz (momentumOperatorSchwartz ψ) = momentumOperatorSchwartz (positionOperatorSchwartz ψ) - + (Complex.I * ℏ) • ψ := by - rw [← positionOperatorSchwartz_commutation_momentumOperatorSchwartz] - simp + + (Complex.I * ℏ) • ψ := + sub_eq_iff_eq_add'.mp (positionOperatorSchwartz_commutation_momentumOperatorSchwartz ψ) lemma momentumOperatorSchwartz_positionOperatorSchwartz_eq (ψ : 𝓢(ℝ, ℂ)) : momentumOperatorSchwartz (positionOperatorSchwartz ψ) = positionOperatorSchwartz (momentumOperatorSchwartz ψ) - (Complex.I * ℏ) • ψ := by - rw [← positionOperatorSchwartz_commutation_momentumOperatorSchwartz] - simp + simp [← positionOperatorSchwartz_commutation_momentumOperatorSchwartz ψ] end end OneDimension diff --git a/Physlib/QuantumMechanics/OneDimension/Operators/Unbounded.lean b/Physlib/QuantumMechanics/OneDimension/Operators/Unbounded.lean index 991541714..8cd6bc5ce 100644 --- a/Physlib/QuantumMechanics/OneDimension/Operators/Unbounded.lean +++ b/Physlib/QuantumMechanics/OneDimension/Operators/Unbounded.lean @@ -58,18 +58,7 @@ lemma isGeneralizedEigenvector_ofSelfCLM_iff {Op : S →L[ℂ] S} (F : S →L[ℂ] ℂ) (c : ℂ) : IsGeneralizedEigenvector (ofSelfCLM (hι := hι) Op) F c ↔ ∀ ψ : S, F (Op ψ) = c • F ψ := by - constructor - · intro h ψ - obtain ⟨ψ', hψ', hF⟩ := h ψ - simp at hψ' - rw [hι.eq_iff] at hψ' - subst hψ' - exact hF - · intro h ψ - use Op ψ - constructor - · simp - · rw [h ψ] + simp only [IsGeneralizedEigenvector, ofSelfCLM_apply, hι.eq_iff, exists_eq_left] open InnerProductSpace diff --git a/Physlib/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean b/Physlib/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean index 9151f8a44..436ffbaf6 100644 --- a/Physlib/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean +++ b/Physlib/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean @@ -77,34 +77,19 @@ noncomputable def mulByTemperateGrowth {g : ℝ → ℂ} (hg : g.HasTemperateGro -- First, you need a theorem that the scaled tanh has temperate growth lemma scaled_tanh_hasTemperateGrowth (κ : ℝ) : - Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x))) := by - exact tanh_const_mul_hasTemperateGrowth κ + Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x))) := + tanh_const_mul_hasTemperateGrowth κ /-- This is a helper lemma to show that the embedding of a real function with temperate growth in ℂ also has temperate growth -/ private lemma complex_embedding_of_temperate_growth (f : ℝ → ℝ) - (h : Function.HasTemperateGrowth f) : Function.HasTemperateGrowth (fun x => (f x : ℂ)) := by - obtain ⟨h1, h2⟩ := h - constructor - · apply ContDiff.fun_comp - apply ContinuousLinearMap.contDiff Complex.ofRealCLM - apply h1 - · intro n - obtain ⟨k, C, j⟩ := h2 n - use k, C - intro x - change ‖iteratedFDeriv ℝ n (RCLike.ofRealLI ∘ f) x‖ ≤ C * (1 + ‖x‖) ^ k - rw [LinearIsometry.norm_iteratedFDeriv_comp_left (g := RCLike.ofRealLI (K := ℂ)) - (hf := h1.contDiffAt)] - exact j x - · apply ENat.natCast_le_of_coe_top_le_withTop - simp only [le_refl] + (h : Function.HasTemperateGrowth f) : Function.HasTemperateGrowth (fun x => (f x : ℂ)) := + Function.Complex.hasTemperateGrowth_ofReal.comp h -- Scaled tanh embedded into the complex numbers has temperate growth lemma scaled_tanh_complex_hasTemperateGrowth (κ : ℝ) : - Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x) : ℂ)) := by - apply complex_embedding_of_temperate_growth - apply scaled_tanh_hasTemperateGrowth + Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x) : ℂ)) := + complex_embedding_of_temperate_growth _ (scaled_tanh_hasTemperateGrowth κ) /-- Define tanh(κ X) multiplication pointwise as a Schwartz map -/ noncomputable def tanhOperatorSchwartz (Q : ReflectionlessPotential) : diff --git a/Physlib/Relativity/LorentzAlgebra/Basic.lean b/Physlib/Relativity/LorentzAlgebra/Basic.lean index 6d557d799..7666e630f 100644 --- a/Physlib/Relativity/LorentzAlgebra/Basic.lean +++ b/Physlib/Relativity/LorentzAlgebra/Basic.lean @@ -52,40 +52,31 @@ lemma mem_iff {A : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ} : lemma mem_iff' (A : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ) : A ∈ lorentzAlgebra ↔ A = - η * Aᵀ * η := by rw [mem_iff] - refine Iff.intro (fun h => ?_) (fun h => ?_) - · trans -η * (Aᵀ * η) - · rw [h] - trans (η * η) * A - · rw [minkowskiMatrix.sq] - noncomm_ring - · noncomm_ring - · noncomm_ring - · nth_rewrite 2 [h] - trans (η * η) * Aᵀ * η - · rw [minkowskiMatrix.sq] - noncomm_ring - · noncomm_ring + constructor + · intro h + rw [mul_assoc, h, ← mul_assoc, neg_mul_neg, minkowskiMatrix.sq, one_mul] + · intro h + nth_rewrite 2 [h] + rw [← mul_assoc, ← mul_assoc, neg_mul_neg, minkowskiMatrix.sq, one_mul] lemma diag_comp (Λ : lorentzAlgebra) (μ : Fin 1 ⊕ Fin 3) : Λ.1 μ μ = 0 := by - have h := congrArg (fun M ↦ M μ μ) $ mem_iff.mp Λ.2 + have h := congrArg (fun M ↦ M μ μ) $ transpose_eta Λ simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, mul_diagonal, transpose_apply, diagonal_neg, diagonal_mul, neg_mul] at h - rcases μ with μ | μ - · simp only [Sum.elim_inl, mul_one, one_mul] at h - exact eq_zero_of_neg_eq (id (Eq.symm h)) - · simp only [Sum.elim_inr, mul_neg, mul_one, neg_mul, one_mul, neg_neg] at h - exact eq_zero_of_neg_eq h + rcases μ with μ | μ <;> + simp only [Sum.elim_inl, Sum.elim_inr, mul_one, one_mul, mul_neg, neg_mul, neg_neg] at h <;> + linarith lemma time_comps (Λ : lorentzAlgebra) (i : Fin 3) : Λ.1 (Sum.inr i) (Sum.inl 0) = Λ.1 (Sum.inl 0) (Sum.inr i) := by simpa only [Fin.isValue, minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, mul_diagonal, transpose_apply, Sum.elim_inr, mul_neg, mul_one, diagonal_neg, diagonal_mul, Sum.elim_inl, - neg_mul, one_mul, neg_inj] using congrArg (fun M ↦ M (Sum.inl 0) (Sum.inr i)) $ mem_iff.mp Λ.2 + neg_mul, one_mul, neg_inj] using congrArg (fun M ↦ M (Sum.inl 0) (Sum.inr i)) $ transpose_eta Λ lemma space_comps (Λ : lorentzAlgebra) (i j : Fin 3) : Λ.1 (Sum.inr i) (Sum.inr j) = - Λ.1 (Sum.inr j) (Sum.inr i) := by simpa only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_neg, diagonal_mul, Sum.elim_inr, neg_neg, one_mul, mul_diagonal, transpose_apply, mul_neg, mul_one] using - (congrArg (fun M ↦ M (Sum.inr i) (Sum.inr j)) $ mem_iff.mp Λ.2).symm + (congrArg (fun M ↦ M (Sum.inr i) (Sum.inr j)) $ transpose_eta Λ).symm end lorentzAlgebra diff --git a/Physlib/Relativity/LorentzAlgebra/Basis.lean b/Physlib/Relativity/LorentzAlgebra/Basis.lean index 190f4ee40..d40c2a667 100644 --- a/Physlib/Relativity/LorentzAlgebra/Basis.lean +++ b/Physlib/Relativity/LorentzAlgebra/Basis.lean @@ -104,80 +104,42 @@ def rotationGenerator (i : Fin 3) : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) lemma boostGenerator_mem (i : Fin 3) : boostGenerator i ∈ lorentzAlgebra := by rw [lorentzAlgebra.mem_iff] ext μ ν - simp only [boostGenerator, minkowskiMatrix.as_diagonal, mul_diagonal, transpose_apply] - rcases μ with μ | μ <;> rcases ν with ν | ν - · -- (time, time) case - simp only [Sum.elim_inl] - have : μ = 0 := Subsingleton.elim _ _ - have : ν = 0 := Subsingleton.elim _ _ - simp [boostGenerator, *] - · -- (time, space) case - simp only [Sum.elim_inr] - have : μ = 0 := Subsingleton.elim _ _ - simp [boostGenerator, *] - split_ifs <;> norm_num - · -- (space, time) case - simp only [Sum.elim_inl] - have : ν = 0 := Subsingleton.elim _ _ - simp [boostGenerator, *] - · -- (space, space) case - simp [Sum.elim_inr, boostGenerator] + fin_cases μ <;> fin_cases ν <;> + simp [boostGenerator, minkowskiMatrix.as_diagonal, mul_diagonal, diagonal_mul, neg_ite] /-- The rotation generator J_i is in the Lorentz algebra. -/ lemma rotationGenerator_mem (i : Fin 3) : rotationGenerator i ∈ lorentzAlgebra := by rw [lorentzAlgebra.mem_iff] ext μ ν - simp only [rotationGenerator, minkowskiMatrix.as_diagonal, mul_diagonal, transpose_apply] - rcases μ with μ | μ <;> rcases ν with ν | ν - · -- (time, time) case - have : μ = 0 := Subsingleton.elim _ _ - have : ν = 0 := Subsingleton.elim _ _ - simp [rotationGenerator, *] - fin_cases i <;> norm_num - · -- (time, space) case - have : μ = 0 := Subsingleton.elim _ _ - simp [rotationGenerator, *] - · -- (space, time) case - have : ν = 0 := Subsingleton.elim _ _ - simp [rotationGenerator, *] - · -- (space, space) case: need explicit computation - simp only [Sum.elim_inr] - fin_cases i <;> fin_cases μ <;> fin_cases ν <;> simp [rotationGenerator] + fin_cases i <;> fin_cases μ <;> fin_cases ν <;> + simp [rotationGenerator, minkowskiMatrix.as_diagonal, mul_diagonal, diagonal_mul] /-- The boost generators are symmetric. -/ @[simp] lemma boostGenerator_transpose (i : Fin 3) : (boostGenerator i)ᵀ = boostGenerator i := by ext μ ν - rcases μ with μ | μ <;> rcases ν with ν | ν <;> - fin_cases μ <;> fin_cases ν <;> simp [boostGenerator] + simp only [transpose_apply, boostGenerator, and_comm, or_comm] /-- The boost generators are traceless. -/ @[simp] lemma boostGenerator_trace (i : Fin 3) : Matrix.trace (boostGenerator i) = 0 := by - rw [Matrix.trace] - apply Finset.sum_eq_zero - intro μ _ - rcases μ with μ | μ <;> simp [boostGenerator] + simp [Matrix.trace, Matrix.diag, boostGenerator] /-- The rotation generators are antisymmetric. -/ @[simp] lemma rotationGenerator_transpose (i : Fin 3) : (rotationGenerator i)ᵀ = -rotationGenerator i := by ext μ ν - fin_cases i <;> rcases μ with μ | μ <;> rcases ν with ν | ν <;> - fin_cases μ <;> fin_cases ν <;> simp [rotationGenerator] + fin_cases i <;> fin_cases μ <;> fin_cases ν <;> simp [rotationGenerator] /-- The rotation generators are traceless. -/ @[simp] lemma rotationGenerator_trace (i : Fin 3) : Matrix.trace (rotationGenerator i) = 0 := by - rw [Matrix.trace] - apply Finset.sum_eq_zero - intro μ _ - rcases μ with μ | μ - · fin_cases i <;> simp [rotationGenerator] - · fin_cases i <;> fin_cases μ <;> simp [rotationGenerator] + have h := Matrix.trace_transpose (rotationGenerator i) + rw [rotationGenerator_transpose, Matrix.trace_neg] at h + exact eq_zero_of_neg_eq h end lorentzAlgebra diff --git a/Physlib/Relativity/LorentzGroup/Boosts/Apply.lean b/Physlib/Relativity/LorentzGroup/Boosts/Apply.lean index 9f7ff3a9e..d8b609886 100644 --- a/Physlib/Relativity/LorentzGroup/Boosts/Apply.lean +++ b/Physlib/Relativity/LorentzGroup/Boosts/Apply.lean @@ -27,46 +27,25 @@ namespace Vector lemma boost_time_eq (i : Fin d) (β : ℝ) (hβ : |β| < 1) (p : Vector d) : (boost i β hβ • p) (Sum.inl 0) = γ β * (p (Sum.inl 0) - β * p (Sum.inr i)) := by - rw [smul_eq_sum] - simp [Fin.isValue, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, - Finset.sum_singleton] - rw [Finset.sum_eq_single i] - · simp - ring - · intro b _ hbi - rw [boost_inl_0_inr_other] - · simp - · exact hbi - · simp + rw [smul_eq_sum, Fintype.sum_sum_type, + Fintype.sum_eq_single i fun b hb => by simp [boost_inl_0_inr_other hβ hb]] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, + boost_inl_0_inl_0, boost_inl_0_inr_self, neg_mul] + ring lemma boost_inr_self_eq (i : Fin d) (β : ℝ) (hβ : |β| < 1) (p : Vector d) : (boost i β hβ • p) (Sum.inr i) = γ β * (p (Sum.inr i) - β * p (Sum.inl 0)) := by - rw [smul_eq_sum] - simp only [Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, - Finset.sum_singleton, boost_inr_self_inl_0, neg_mul] - rw [Finset.sum_eq_single i] - · simp only [Fin.isValue, boost_inr_self_inr_self] - ring - · intro b _ hbi - rw [boost_inr_self_inr_other] - · simp - · exact hbi - · simp + rw [smul_eq_sum, Fintype.sum_sum_type, + Fintype.sum_eq_single i fun b hb => by simp [boost_inr_self_inr_other hβ hb]] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, + boost_inr_self_inl_0, neg_mul, boost_inr_self_inr_self] + ring lemma boost_inr_other_eq (i j : Fin d) (hji : j ≠ i) (β : ℝ) (hβ : |β| < 1) (p : Vector d) : (boost i β hβ • p) (Sum.inr j) = p (Sum.inr j) := by - rw [smul_eq_sum] - simp only [Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, - Finset.sum_singleton] - rw [boost_inr_other_inl_0 hβ hji] - rw [Finset.sum_eq_single j] - · rw [boost_inr_other_inr hβ hji] - simp - · intro b _ hbj - rw [boost_inr_other_inr hβ hji] - rw [if_neg ((Ne.symm hbj))] - simp - · simp + rw [smul_eq_sum, Fintype.sum_sum_type, + Fintype.sum_eq_single j fun b hb => by simp [boost_inr_other_inr hβ hji, Ne.symm hb]] + simp [boost_inr_other_inl_0 hβ hji, boost_inr_other_inr hβ hji] lemma boost_toCoord_eq (i : Fin d) (β : ℝ) (hβ : |β| < 1) (p : Vector d) : (boost i β hβ • p) = fun j => @@ -80,11 +59,8 @@ lemma boost_toCoord_eq (i : Fin d) (β : ℝ) (hβ : |β| < 1) (p : Vector d) : | Sum.inl 0 => rw [boost_time_eq] | Sum.inr j => by_cases hj : j = i - · subst hj - rw [boost_inr_self_eq] - simp - · rw [boost_inr_other_eq _ _ hj] - simp [hj] + · simp [hj, boost_inr_self_eq] + · simp [hj, boost_inr_other_eq _ _ hj] end Vector diff --git a/Physlib/Relativity/LorentzGroup/Restricted/Basic.lean b/Physlib/Relativity/LorentzGroup/Restricted/Basic.lean index f42a69c9a..99e50e7c9 100644 --- a/Physlib/Relativity/LorentzGroup/Restricted/Basic.lean +++ b/Physlib/Relativity/LorentzGroup/Restricted/Basic.lean @@ -53,20 +53,11 @@ lemma isOrthochronous_of_restricted {d : ℕ} (Λ : restricted d) : /-- The restricted Lorentz group is a normal subgroup of the Lorentz group. -/ lemma restricted_normal_subgroup {d : ℕ} : (restricted d).Normal := by have h_proper {Λ P : LorentzGroup d} (hP : IsProper P) : IsProper (Λ * P * Λ⁻¹) := by - simp only [IsProper, lorentzGroupIsGroup_mul_coe, det_mul] - rw [hP, mul_one, ← det_mul, coe_inv, mul_inv_of_invertible, det_one] + rw [isProper_iff] at hP ⊢ + simp only [map_mul, map_inv, hP, mul_one, mul_inv_cancel] have h_ortho {Λ O : LorentzGroup d} (hO : IsOrthochronous O) : IsOrthochronous (Λ * O * Λ⁻¹) := by - by_cases hΛ : IsOrthochronous Λ - · exact isOrthochronous_mul - (isOrthochronous_mul hΛ hO) - (isOrthochronous_inv_iff.mpr hΛ) - · rw [isOrthochronous_mul_iff, isOrthochronous_inv_iff] - simp_all - rw [isOrthochronous_mul_iff] - simp_all - constructor - rintro R ⟨R_proper, R_ortho⟩ Λ - exact ⟨h_proper R_proper, h_ortho R_ortho⟩ + simp [isOrthochronous_mul_iff, isOrthochronous_inv_iff, hO] + exact ⟨fun R hR Λ => ⟨h_proper hR.1, h_ortho hR.2⟩⟩ open TopologicalSpace @@ -80,13 +71,8 @@ semiformal_result "FXNL5" restricted_isConnected {d : ℕ} : lemma restricted_eq_identity_component_of_isConnected {d : ℕ} (h1 : IsConnected (restricted d : Set (LorentzGroup d))) : (restricted d) = connectedComponent (1 : LorentzGroup d) := by - ext x - constructor - · intro hx - have h_id : 1 ∈ restricted d := by simp [restricted, IsOrthochronous] - exact IsConnected.subset_connectedComponent h1 h_id hx - · intro h - exact ⟨(isProper_on_connected_component h).mp isProper_id, - (isOrthochronous_on_connected_component h).mp id_isOrthochronous⟩ + exact Set.Subset.antisymm (IsConnected.subset_connectedComponent h1 (restricted d).one_mem) + fun x h => ⟨(isProper_on_connected_component h).mp isProper_id, + (isOrthochronous_on_connected_component h).mp id_isOrthochronous⟩ end LorentzGroup diff --git a/Physlib/Relativity/PauliMatrices/CliffordAlgebra.lean b/Physlib/Relativity/PauliMatrices/CliffordAlgebra.lean index 2681978e8..b20bc39cf 100644 --- a/Physlib/Relativity/PauliMatrices/CliffordAlgebra.lean +++ b/Physlib/Relativity/PauliMatrices/CliffordAlgebra.lean @@ -47,11 +47,7 @@ lemma ofCliffordAlgebra_ι_single (i : Fin 3) (r : ℝ) : CliffordAlgebra.lift_ι_apply _ _ _ |>.trans <| Subtype.ext <| by simp only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, LinearMap.coe_sum, LinearMap.coe_smulRight, LinearMap.coe_proj, Function.eval, SetLike.mk_smul_mk, - Finset.sum_apply, AddSubmonoidClass.coe_finsetSum] - rw [Finset.sum_eq_single i] - · simp - · intro b _ hb - simp [Pi.single_eq_of_ne hb] - · simp + Finset.sum_apply, AddSubmonoidClass.coe_finsetSum, Pi.single_apply, ite_smul, zero_smul, + Finset.sum_ite_eq', Finset.mem_univ, if_true] end PauliMatrix diff --git a/Physlib/Relativity/Special/TwinParadox/Basic.lean b/Physlib/Relativity/Special/TwinParadox/Basic.lean index 6162c052d..a681f7350 100644 --- a/Physlib/Relativity/Special/TwinParadox/Basic.lean +++ b/Physlib/Relativity/Special/TwinParadox/Basic.lean @@ -126,17 +126,12 @@ lemma example1_properTimeTwinA : example1.properTimeTwinA = 15 := by @[simp] lemma example1_properTimeTwinB : example1.properTimeTwinB = 9 := by - simp only [properTimeTwinB, properTime, example1, sub_zero, minkowskiProduct_toCoord, - Fin.sum_univ_three, MulZeroClass.mul_zero, _root_.add_zero, map_sub, - FunLike.coe_sub, Pi.sub_apply, Finset.sum_const_zero, MulZeroClass.zero_mul] - norm_num - rw [show √81 = 9 from sqrt_eq_cases.mpr (by norm_num)] - rw [show √4 = 2 from sqrt_eq_cases.mpr (by norm_num)] - norm_num + simp [properTimeTwinB, properTime, example1, minkowskiProduct_toCoord, Fin.sum_univ_three] + norm_num [show √81 = 9 from sqrt_eq_cases.mpr (by norm_num), + show √4 = 2 from sqrt_eq_cases.mpr (by norm_num)] lemma example1_ageGap : example1.ageGap = 6 := by - simp [ageGap] - norm_num + norm_num [ageGap] end InstantaneousTwinParadox diff --git a/Physlib/Relativity/Tensors/Basic.lean b/Physlib/Relativity/Tensors/Basic.lean index efc05c52f..fad9622ff 100644 --- a/Physlib/Relativity/Tensors/Basic.lean +++ b/Physlib/Relativity/Tensors/Basic.lean @@ -99,11 +99,8 @@ lemma congr_mid {n : ℕ} {c : Fin n → C} (c' : C) (p : Pure S c) (i j : Fin n) (h : i = j) (hi : c i = c') (hj : c j = c') : LinearEquiv.cast (R := k) (by rw [hi] : c i = c') (p i) = LinearEquiv.cast (R := k) (by rw [hj] : c j = c') (p j) := by - subst hi - simp only [LinearEquiv.cast_apply, cast_eq] - symm - apply congr_right - exact h + subst h hi + simp lemma map_mid_move_left {n n1 : ℕ} {c : Fin n → C} {c1 : Fin n1 → C} (p : Pure S c) (p' : Pure S c1) {c' : C} @@ -141,16 +138,13 @@ lemma update_same {n : ℕ} {c : Fin n → C} [inst : DecidableEq (Fin n)] (p : lemma update_diff {n : ℕ} {c : Fin n → C} [inst : DecidableEq (Fin n)] (p : Pure S c) (i j : Fin n) (x : V (c i)) (hij : i ≠ j) : (update p i x) j = p j := by - simp_all [update, Function.update] - grind + rw [update_eq_function_update, Function.update_of_ne hij.symm] @[simp] lemma update_succAbove_apply {n : ℕ} {c : Fin (n + 1) → C} [inst : DecidableEq (Fin (n + 1))] (p : Pure S c) (i : Fin (n + 1)) (j : Fin n) (x : V (c (i.succAbove j))) : update p (i.succAbove j) x i = p i := by - simp only [update] - rw [Function.update_of_ne] - exact Fin.ne_succAbove i j + rw [update_eq_function_update, Function.update_of_ne (Fin.ne_succAbove i j)] @[simp] lemma toTensor_update_add {n : ℕ} {c : Fin n → C} [inst : DecidableEq (Fin n)] (p : Pure S c) @@ -175,26 +169,15 @@ def drop {n : ℕ} {c : Fin (n + 1) → C} (p : Pure S c) (i : Fin (n + 1)) : @[simp] lemma update_succAbove_drop {n : ℕ} {c : Fin (n + 1) → C} [inst : DecidableEq (Fin (n + 1))] (p : Pure S c) (i : Fin (n + 1)) (k : Fin n) (x : V (c (i.succAbove k))) : - (update p (i.succAbove k) x).drop i = (p.drop i).update k x := by - ext j - simp only [Function.comp_apply, drop, update] - by_cases h : j = k - · subst h - simp - · rw [Function.update_of_ne h, Function.update_of_ne] - · rfl - · simp only [ne_eq] - rw [Function.Injective.eq_iff (Fin.succAbove_right_injective (p := i))] - exact h + (update p (i.succAbove k) x).drop i = (p.drop i).update k x := + Function.update_comp_eq_of_injective' p Fin.succAbove_right_injective k x @[simp] lemma update_drop_self {n : ℕ} {c : Fin (n + 1) → C} [inst : DecidableEq (Fin (n + 1))] (p : Pure S c) (i : Fin (n + 1)) (x : V (c i)) : (update p i x).drop i = p.drop i := by - ext k - simp only [Function.comp_apply, drop, update] - rw [Function.update_of_ne] - exact Fin.succAbove_ne i k + ext j + simp [drop, update_eq_function_update] /-! @@ -217,10 +200,8 @@ lemma component_eq {n : ℕ} {c : Fin n → C} (p : Pure S c) (φ : ComponentIdx lemma component_eq_drop {n : ℕ} {c : Fin (n + 1) → C} (p : Pure S c) (i : Fin (n + 1)) (φ : ComponentIdx c) : p.component φ = ((b (c i)).repr (p i) (φ i)) * - ((drop p i).component (fun j => φ (i.succAbove j))) := by - simp only [component, Function.comp_apply] - rw [Fin.prod_univ_succAbove _ i] - rfl + ((drop p i).component (fun j => φ (i.succAbove j))) := + Fin.prod_univ_succAbove (fun j => (b (c j)).repr (p j) (φ j)) i @[simp] lemma component_update_add {n : ℕ} [inst : DecidableEq (Fin n)] @@ -230,9 +211,7 @@ lemma component_update_add {n : ℕ} [inst : DecidableEq (Fin n)] (update p i y).component b := by cases n · exact Fin.elim0 i - rename_i n - rw [component_eq_drop _ i, component_eq_drop _ i, component_eq_drop _ i] - simp [add_mul] + · simp [component_eq_drop _ i, add_mul] @[simp] lemma component_update_smul {n : ℕ} [inst : DecidableEq (Fin n)] @@ -241,10 +220,7 @@ lemma component_update_smul {n : ℕ} [inst : DecidableEq (Fin n)] (update p i (x • y)).component b = x * (update p i y).component b := by cases n · exact Fin.elim0 i - rename_i n - rw [component_eq_drop _ i, component_eq_drop _ i] - simp only [update_same, map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, update_drop_self] - ring + · simp [component_eq_drop _ i, mul_assoc] /-- The multilinear map taking pure tensors `p` to a map `ComponentIdx c → k` which when evaluated returns the components of `p`. -/ @@ -274,22 +250,7 @@ noncomputable def basisVector {n : ℕ} (c : Fin n → C) (φ : ComponentIdx (S @[simp] lemma component_basisVector {n : ℕ} (c : Fin n → C) (b1 b2 : ComponentIdx (S := S) c) : (basisVector c b1).component b2 = if b1 = b2 then 1 else 0 := by - simp only [basisVector, component_eq, funext_iff] - simp only [Basis.repr_self] - by_cases h : b1 = b2 - · subst h - simp - · rw [funext_iff] at h - simp only [not_forall] at h - obtain ⟨i, hi⟩ := h - split - next h => simp_all only [not_true_eq_false] - next h => - simp_all only [not_forall] - obtain ⟨w, h⟩ := h - refine Finset.prod_eq_zero (Finset.mem_univ i) ?_ - rw [Finsupp.single_eq_of_ne] - exact fun a => hi (id (Eq.symm a)) + simp [component_eq, basisVector, Finsupp.single_apply, Fintype.prod_boole, funext_iff] end Pure @@ -297,12 +258,9 @@ lemma induction_on_pure {n : ℕ} {c : Fin n → C} {P : S.Tensor c → Prop} (h : ∀ (p : Pure S c), P p.toTensor) (hsmul : ∀ (r : k) t, P t → P (r • t)) (hadd : ∀ t1 t2, P t1 → P t2 → P (t1 + t2)) (t : S.Tensor c) : P t := by - refine PiTensorProduct.induction_on' t ?_ ?_ - · intro r p - simp only [PiTensorProduct.tprodCoeff_eq_smul_tprod] - exact hsmul r _ (h p) - · intro t1 t2 - exact fun a a_1 => hadd t1 t2 a a_1 + refine PiTensorProduct.induction_on' t (fun r p => ?_) hadd + simp only [PiTensorProduct.tprodCoeff_eq_smul_tprod] + exact hsmul r _ (h p) /-! @@ -318,10 +276,8 @@ def componentMap {n : ℕ} (c : Fin n → C) : S.Tensor c →ₗ[k] (ComponentId @[simp] lemma componentMap_pure {n : ℕ} (c : Fin n → C) - (p : Pure S c) : componentMap c (p.toTensor) = Pure.componentMap c p := by - simp only [componentMap, Pure.toTensor] - change (PiTensorProduct.lift (Pure.componentMap c)) ((PiTensorProduct.tprod k) p) = _ - simp + (p : Pure S c) : componentMap c (p.toTensor) = Pure.componentMap c p := + PiTensorProduct.lift.tprod p /-- The tensor created from it's components. -/ def ofComponents {n : ℕ} (c : Fin n → C) : @@ -342,30 +298,17 @@ lemma componentMap_ofComponents {n : ℕ} (c : Fin n → C) (f : ComponentIdx c lemma ofComponents_componentMap {n : ℕ} (c : Fin n → C) (t : S.Tensor c) : ofComponents c (componentMap c t) = t := by simp only [ofComponents, LinearMap.coe_mk, AddHom.coe_mk] - apply induction_on_pure ?_ ?_ ?_ t - · intro p + induction t using induction_on_pure with + | h p => simp only [componentMap_pure, Pure.componentMap_apply] - have h1 (x : ComponentIdx c) : p.component x • (Pure.basisVector c x).toTensor = - Pure.toTensor (fun i => ((b (c i)).repr (p i)) (x i) • (b (c i)) (x i)) := by - rw [Pure.component_eq, Pure.toTensor] - exact Eq.symm (MultilinearMap.map_smul_univ (PiTensorProduct.tprod k) - (fun i => ((b (c i)).repr (p i)) (x i)) fun i => (b (c i)) (x i)) - conv_lhs => - enter [2, x] - rw [h1] + simp_rw [Pure.component_eq, Pure.toTensor, ← MultilinearMap.map_smul_univ, Pure.basisVector] trans (PiTensorProduct.tprod k) fun i => ∑ x, ((b (c i)).repr (p i)) x • (b (c i)) x - · exact (MultilinearMap.map_sum (PiTensorProduct.tprod k) fun i j => - ((b (c i)).repr (p i)) j • (b (c i)) j).symm - congr - funext i - exact Basis.sum_equivFun (b (c i)) (p i) - · intro r t ht - simp only [map_smul, Pi.smul_apply, smul_eq_mul, ← smul_smul] - conv_rhs => rw [← ht] - exact Eq.symm Finset.smul_sum - · intro t1 t2 h1 h2 - simp [add_smul, Finset.sum_add_distrib, h1, h2] + · exact (MultilinearMap.map_sum _ fun i j => ((b (c i)).repr (p i)) j • (b (c i)) j).symm + exact congrArg _ (funext fun i => Basis.sum_equivFun (b (c i)) (p i)) + | hsmul r t ht => + simp only [map_smul, Pi.smul_apply, smul_eq_mul, ← smul_smul, ← Finset.smul_sum, ht] + | hadd t1 t2 h1 h2 => simp [add_smul, Finset.sum_add_distrib, h1, h2] /-- The basis of tensors. -/ def basis {n : ℕ} (c : Fin n → C) : Basis (ComponentIdx (S := S) c) k (S.Tensor c) where @@ -376,14 +319,7 @@ def basis {n : ℕ} (c : Fin n → C) : Basis (ComponentIdx (S := S) c) k (S.Ten lemma basis_apply {n : ℕ} (c : Fin n → C) (φ : ComponentIdx (S := S) c) : basis c φ = (Pure.basisVector c φ).toTensor := by change ofComponents c _ = _ - simp only [ofComponents, LinearEquiv.coe_toEquiv_symm, LinearEquiv.symm_symm, EquivLike.coe_coe, - Finsupp.linearEquivFunOnFinite_single, LinearMap.coe_mk, AddHom.coe_mk] - rw [Finset.sum_eq_single φ] - · simp - · intro b' _ hb - rw [Pi.single_apply] - simp [hb] - · simp + simp [ofComponents, Finsupp.linearEquivFunOnFinite_single, Pi.single_apply, ite_smul] @[simp] lemma basis_repr_pure {n : ℕ} (c : Fin n → C) @@ -397,18 +333,10 @@ lemma induction_on_basis {n : ℕ} {c : Fin n → C} {P : S.Tensor c → Prop} (h : ∀ b, P (basis c b)) (hzero : P 0) (hsmul : ∀ (r : k) t, P t → P (r • t)) (hadd : ∀ t1 t2, P t1 → P t2 → P (t1 + t2)) (t : S.Tensor c) : P t := by - let Pt (t : S.Tensor c) - (ht : t ∈ Submodule.span k (Set.range (basis c))) := P t - change Pt t (Basis.mem_span _ t) - apply Submodule.span_induction - · intro x hx - obtain ⟨b, rfl⟩ := Set.mem_range.mp hx - exact h b - · simp [Pt, hzero] - · intro t1 t2 h1 h2 - exact fun a a_1 => hadd t1 t2 a a_1 - · intro r t ht - exact fun a => hsmul r t a + refine Submodule.span_induction ?_ hzero (fun t1 t2 _ _ => hadd t1 t2) + (fun r t _ => hsmul r t) (Basis.mem_span (basis c) t) + rintro x ⟨b, rfl⟩ + exact h b /-- `componentMap` is the basis representation `(basis c).repr` definitionally; this bridges the two notations wherever a component computation meets a `repr` rewrite. -/ @@ -418,8 +346,7 @@ lemma componentMap_eq_repr {n : ℕ} (c : Fin n → C) (t : S.Tensor c) /-- Two tensors with the same colour sequence are equal when all their components agree. -/ lemma componentMap_ext {n : ℕ} {c : Fin n → C} {t₁ t₂ : S.Tensor c} (h : ∀ b, componentMap c t₁ b = componentMap c t₂ b) : t₁ = t₂ := by - rw [← ofComponents_componentMap c t₁, ← ofComponents_componentMap c t₂] - congr 1; funext b; exact h b + rw [← ofComponents_componentMap c t₁, ← ofComponents_componentMap c t₂, funext h] end Basis @@ -516,20 +443,17 @@ noncomputable instance actionT : MulAction G (S.Tensor c) where rfl lemma actionT_pure {g : G} {p : Pure S c} : - g • p.toTensor = Pure.toTensor (g • p) := by - rw [actionT_eq, Pure.toTensor, PiTensorProduct.map_tprod] - rfl + g • p.toTensor = Pure.toTensor (g • p) := + PiTensorProduct.map_tprod (R := k) (fun i => rep (c i) g) p lemma actionT_add {g : G} {t1 t2 : S.Tensor c} : g • (t1 + t2) = g • t1 + g • t2 := by - rw [actionT_eq, actionT_eq, actionT_eq] - simp + simp [actionT_eq] @[simp] lemma actionT_smul {g : G} {r : k} {t : S.Tensor c} : g • (r • t) = r • (g • t) := by - rw [actionT_eq, actionT_eq (S := S)] - simp + simp [actionT_eq] lemma actionT_zero {g : G} : g • (0 : S.Tensor c) = 0 := by simp [actionT_eq] @@ -567,25 +491,14 @@ lemma Pure.permP_basisVector {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} Pure.basisVector c1 (fun i => basisIdxCongr (by simp [h.preserve_color]) (φ (σ i))) := by ext i simp only [permP, basisVector] - have h1 {c1 c2 : C} (h : c1 = c2) (x : basisIdx c1) : - LinearEquiv.cast (R := k) (by simp [h]) ((b (c1)) x) = - (b c2) (basisIdxCongr (by simp [h]) x) := by - subst h - simp - apply h1 - simp [h.preserve_color] + apply map_basis_eq lemma Pure.permP_equivariant {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) (g : G) (p : Pure S c) : Pure.permP σ h (g • p) = g • Pure.permP σ h p := by ext i simp only [permP, actionP_eq] - generalize p (σ i) = p - generalize_proofs h1 h2 - generalize c1 i = c' at * - generalize c (σ i) = c at * - subst h2 - simp + exact rep_cast _ _ /-- The reindexing of a tensor based on a map `σ : Fin m → Fin n` of indices satisfying `IsReindexing`. -/ @@ -599,7 +512,7 @@ lemma permT_pure {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) (p : Pure S c) : permT σ h p.toTensor = (p.permP σ h).toTensor := by simp only [permT, Pure.toTensor, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, - PiTensorProduct.reindex_tprod, PiTensorProduct.map_tprod, LinearEquiv.cast_apply] + PiTensorProduct.reindex_tprod, PiTensorProduct.map_tprod] rfl set_option backward.isDefEq.respectTransparency false in @@ -612,17 +525,10 @@ lemma Pure.permP_id_self {n : ℕ} {c : Fin n → C} (p : Pure S c) : @[simp] lemma permT_id_self {n : ℕ} {c : Fin n → C} (t : S.Tensor c) : permT (id : Fin n → Fin n) (by simp : IsReindexing c c id) t = t := by - let P (t : S.Tensor c) := permT (id : Fin n → Fin n) (by simp : IsReindexing c c id) t = t - change P t - apply induction_on_pure - · intro p - simp [P] - rw [permT_pure] - simp - · intro r t ht - simp [P, ht] - · intro t1 t2 h1 h2 - simp [P, h1, h2] + induction t using induction_on_pure with + | h p => simp [permT_pure] + | hsmul r t ht => simp [ht] + | hadd t1 t2 h1 h2 => simp [h1, h2] lemma permT_congr_eq_id {n : ℕ} {c : Fin n → C} (t : S.Tensor c) (σ : Fin n → Fin n) (hσ : IsReindexing c c σ) (h : σ = id) : @@ -640,16 +546,10 @@ lemma permT_congr_eq_id' {n : ℕ} {c : Fin n → C} (t t1 : S.Tensor c) lemma permT_equivariant {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) (g : G) (t : S.Tensor c) : permT σ h (g • t) = g • permT σ h t := by - apply induction_on_pure (t := t) - · intro p - simp [actionT_pure, permT_pure] - congr - simp [Pure.permP_equivariant] - · intro r t ht - rw [actionT_smul, map_smul] - simp [ht] - · intro t1 t2 h1 h2 - simp [h1, h2] + induction t using induction_on_pure with + | h p => simp [actionT_pure, permT_pure, Pure.permP_equivariant] + | hsmul r t ht => simp [ht] + | hadd t1 t2 h1 h2 => simp [h1, h2] @[congr] lemma Pure.permP_congr {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} @@ -674,26 +574,18 @@ lemma Pure.permP_permP {n m1 m2 : ℕ} {c : Fin n → C} {c1 : Fin m1 → C} {c2 (h2 : IsReindexing c1 c2 σ2) (p : Pure S c) : Pure.permP σ2 h2 (Pure.permP σ h p) = Pure.permP (σ ∘ σ2) (h.comp h2) p := by ext i - simp [permP, Pure.permP, Function.comp_apply] + simp [permP] @[simp] lemma permT_permT {n m1 m2 : ℕ} {c : Fin n → C} {c1 : Fin m1 → C} {c2 : Fin m2 → C} {σ : Fin m1 → Fin n} {σ2 : Fin m2 → Fin m1} (h : IsReindexing c c1 σ) (h2 : IsReindexing c1 c2 σ2) (t : S.Tensor c) : permT σ2 h2 (permT σ h t) = permT (σ ∘ σ2) (h.comp h2) t := by - let P (t : S.Tensor c) := permT σ2 h2 (permT σ h t) = permT (σ ∘ σ2) (h.comp h2) t - change P t - apply induction_on_basis - · intro b - simp only [P] - rw [basis_apply, permT_pure, permT_pure, permT_pure] - simp only [Pure.permP_basisVector, basisIdxCongr_apply_apply, Function.comp_apply] - rfl - · simp [P] - · intro r t h1 - simp_all [P] - · intro t1 t2 h1 h2 - simp_all [P] + induction t using induction_on_basis with + | h b => rw [basis_apply, permT_pure, permT_pure, permT_pure, Pure.permP_permP] + | hzero => simp + | hsmul r t h1 => simp [h1] + | hadd t1 t2 h1 h2 => simp [h1, h2] lemma permT_basis_repr_symm_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) (t : S.Tensor c) @@ -701,15 +593,13 @@ lemma permT_basis_repr_symm_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → (basis c1).repr (permT σ h t) φ = (basis c).repr t (fun i => basisIdxCongr (by simp [IsReindexing.inv_perserve_color]) (φ (h.inv σ i))) := by - apply induction_on_basis (t := t) - · intro b' - rw [basis_apply] - rw [permT_pure, Pure.permP_basisVector, ← basis_apply, ← basis_apply] - simp only [Basis.repr_self] - rw [Finsupp.single_apply, Finsupp.single_apply] + induction t using induction_on_basis with + | h b' => + rw [basis_apply, permT_pure, Pure.permP_basisVector, ← basis_apply, ← basis_apply] + simp only [Basis.repr_self, Finsupp.single_apply] congr 1 simp only [eq_iff_iff] - apply Iff.intro + constructor · intro h' funext x simpa [← h'] using ComponentIdx.congr_right _ _ _ @@ -718,52 +608,25 @@ lemma permT_basis_repr_symm_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → funext x simpa [h'] using (ComponentIdx.congr_right _ _ _ (IsReindexing.apply_inv_apply σ h x).symm).symm - · simp - · intro r t h - simp [h] - · intro t1 t2 h1 h2 - simp [h1, h2] + | hzero => simp + | hsmul r t h => simp [h] + | hadd t1 t2 h1 h2 => simp [h1, h2] lemma permT_basis {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) (b : ComponentIdx c) : (permT σ h) (basis (S := S) c b) = basis c1 (fun i => basisIdxCongr (by simp [h.2]) (b (σ i))) := by - apply (basis c1).repr.injective - ext b' - rw [permT_basis_repr_symm_apply] - simp only [Basis.repr_self, Finsupp.single_apply] - congr 1 - simp only [eq_iff_iff] - constructor - · intro h - rw [h] - ext i - simp only [basisIdxCongr_apply_apply] - refine Eq.symm (ComponentIdx.congr_right b' i (IsReindexing.inv σ _ (σ i)) ?_) - simp [IsReindexing.apply_inv_apply] - · rintro rfl - ext i - simp only [basisIdxCongr_apply_apply] - apply ComponentIdx.congr_right - simp [IsReindexing.inv_apply_apply] + rw [basis_apply, permT_pure, Pure.permP_basisVector, ← basis_apply] lemma permT_eq_zero_iff {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) (t : S.Tensor c) : permT σ h t = 0 ↔ t = 0 := by - apply Iff.intro - · intro h' - trans permT (h.inv σ) (IsReindexing.symm h) ((permT σ h) t) - · rw [permT_permT] - rw [permT_congr_eq_id'] - · funext x - simp [IsReindexing.inv_apply_apply] - · rfl - · rw [h'] - simp - · intro hzero - rw [hzero] - simp + refine ⟨fun h' => ?_, fun h' => by simp [h']⟩ + have h2 := congrArg (permT (h.inv σ) h.symm) h' + rwa [permT_permT, map_zero, permT_congr_eq_id] at h2 + funext x + simp [IsReindexing.inv_apply_apply] /-! ## field @@ -785,10 +648,7 @@ lemma toField_injective {c : Fin 0 → C} : @[simp] lemma toField_pure {c : Fin 0 → C} (p : Pure S c) : toField (p.toTensor : S.Tensor c) = 1 := by - rw [← toField_default (S := S)] - congr - ext i - exact Fin.elim0 i + rw [Subsingleton.elim p default, toField_default] lemma toField_permT {c c1 : Fin 0 → C} (σ : Fin 0 → Fin 0) (h : IsReindexing c c1 σ) (t : S.Tensor c) : @@ -812,25 +672,16 @@ lemma toField_eq_repr {c : Fin 0 → C} (t : Tensor S c) : t.toField = (basis c).repr t (fun j => Fin.elim0 j) := by obtain ⟨t, rfl⟩ := (basis c).repr.symm.surjective t simp only [Basis.repr_symm_apply, Basis.repr_linearCombination] - rw [@Finsupp.linearCombination_unique] - rw [map_smul] - conv_lhs => - enter [2] - rw [toField_basis_default (c := c)] - simp only [smul_eq_mul, mul_one] + rw [Finsupp.linearCombination_unique, map_smul, toField_basis_default, smul_eq_mul, mul_one] rfl @[simp] lemma toField_equivariant {c : Fin 0 → C} (g : G) (t : Tensor S c) : toField (g • t) = toField t := by - apply induction_on_pure (t := t) - · intro p - rw [actionT_pure] - simp - · intro r t hp - simp [hp] - · intro t1 t2 hp1 hp2 - simp [hp1, hp2] + induction t using induction_on_pure with + | h p => simp [actionT_pure] + | hsmul r t hp => simp [hp] + | hadd t1 t2 hp1 hp2 => simp [hp1, hp2] lemma eq_smul_toField {c : Fin 0 → C} (t : Tensor S c) : t = toField t • (basis c (@default (ComponentIdx (S := S) c) Unique.instInhabited)) := by diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean b/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean index df59945b5..077823827 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean @@ -268,7 +268,7 @@ lemma basisIdxCongr_eq_cast {c1 c2 : complexLorentzTensor.Color} lemma repDim_tau {c : complexLorentzTensor.Color} : repDim (complexLorentzTensor.τ c) = repDim c := by - cases c <;> simp [repDim] <;> rfl + cases c <;> rfl lemma contrPCoeff_basis {n : ℕ} {c : Fin n → complexLorentzTensor.Color} (i j : Fin n) (hij : i ≠ j ∧ (complexLorentzTensor.τ (c i) = c j)) @@ -284,35 +284,15 @@ lemma contrPCoeff_basis {n : ℕ} {c : Fin n → complexLorentzTensor.Color} (i generalize c j = cj at * subst h2 fin_cases ci - · simp [complexLorentzTensor] + all_goals + simp [complexLorentzTensor] erw [LinearEquiv.cast_apply] simp only [cast_eq] - erw [Fermion.leftDualContraction_basis] - grind - · simp [complexLorentzTensor] - erw [LinearEquiv.cast_apply] - simp only [cast_eq] - erw [Fermion.dualLeftContraction_basis] - grind - · simp [complexLorentzTensor] - erw [LinearEquiv.cast_apply] - simp only [cast_eq] - erw [Fermion.dualRightContraction_basis] - grind - · simp [complexLorentzTensor] - erw [LinearEquiv.cast_apply] - simp only [cast_eq] - erw [Fermion.dualLeftContraction_basis] - grind - · simp [complexLorentzTensor] - erw [LinearEquiv.cast_apply] - simp only [cast_eq] - erw [Lorentz.coContrContraction_basis] - grind - · simp [complexLorentzTensor] - erw [LinearEquiv.cast_apply] - simp only [cast_eq] - erw [Lorentz.contrCoContraction_basis] + first + | erw [Fermion.leftDualContraction_basis] + | erw [Fermion.dualLeftContraction_basis] + | erw [Fermion.dualRightContraction_basis] + | erw [Lorentz.coContrContraction_basis] grind end complexLorentzTensor diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Weyl/Two.lean b/Physlib/Relativity/Tensors/ComplexTensor/Weyl/Two.lean index 3f638348d..2f7394d02 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Weyl/Two.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Weyl/Two.lean @@ -40,10 +40,9 @@ lemma leftLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : leftLeftToMatrix.symm M = ∑ i, ∑ j, M i j • (leftBasis i ⊗ₜ[ℂ] leftBasis j) := by simp only [leftLeftToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply leftBasis leftBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `dualLeftHanded ⊗ dualLeftHanded` to `2 x 2` complex matrices. -/ @@ -59,10 +58,9 @@ lemma dualLeftdualLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) (dualLeftBasis i ⊗ₜ[ℂ] dualLeftBasis j) := by simp only [dualLeftdualLeftToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply dualLeftBasis dualLeftBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `leftHanded ⊗ dualLeftHanded` to `2 x 2` complex matrices. -/ @@ -77,10 +75,9 @@ lemma leftDualLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : leftDualLeftToMatrix.symm M = ∑ i, ∑ j, M i j • (leftBasis i ⊗ₜ[ℂ] dualLeftBasis j) := by simp only [leftDualLeftToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply leftBasis dualLeftBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `dualLeftHanded ⊗ leftHanded` to `2 x 2` complex matrices. -/ @@ -95,10 +92,9 @@ lemma dualLeftLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualLeftLeftToMatrix.symm M = ∑ i, ∑ j, M i j • (dualLeftBasis i ⊗ₜ[ℂ] leftBasis j) := by simp only [dualLeftLeftToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply dualLeftBasis leftBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `rightHanded ⊗ rightHanded` to `2 x 2` complex matrices. -/ @@ -113,10 +109,9 @@ lemma rightRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rightRightToMatrix.symm M = ∑ i, ∑ j, M i j • (rightBasis i ⊗ₜ[ℂ] rightBasis j) := by simp only [rightRightToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply rightBasis rightBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `dualRightHanded ⊗ dualRightHanded` to `2 x 2` complex matrices. -/ @@ -132,10 +127,9 @@ lemma dualRightDualRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ∑ i, ∑ j, M i j • (dualRightBasis i ⊗ₜ[ℂ] dualRightBasis j) := by simp only [dualRightDualRightToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply dualRightBasis dualRightBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `rightHanded ⊗ dualRightHanded` to `2 x 2` complex matrices. -/ @@ -150,10 +144,9 @@ lemma rightDualRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rightDualRightToMatrix.symm M = ∑ i, ∑ j, M i j • (rightBasis i ⊗ₜ[ℂ] dualRightBasis j) := by simp only [rightDualRightToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply rightBasis dualRightBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `dualRightHanded ⊗ rightHanded` to `2 x 2` complex matrices. -/ @@ -168,10 +161,9 @@ lemma dualRightRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualRightRightToMatrix.symm M = ∑ i, ∑ j, M i j • (dualRightBasis i ⊗ₜ[ℂ] rightBasis j) := by simp only [dualRightRightToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply dualRightBasis rightBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `dualLeftHanded ⊗ dualRightHanded` to `2 x 2` complex matrices. -/ @@ -187,10 +179,9 @@ lemma dualLeftDualRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ (dualLeftBasis i ⊗ₜ[ℂ] dualRightBasis j) := by simp only [dualLeftDualRightToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply dualLeftBasis dualRightBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- Equivalence of `leftHanded ⊗ rightHanded` to `2 x 2` complex matrices. -/ @@ -204,10 +195,9 @@ lemma leftRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : leftRightToMatrix.symm M = ∑ i, ∑ j, M i j • (leftBasis i ⊗ₜ[ℂ] rightBasis j) := by simp only [leftRightToMatrix, LinearEquiv.trans_symm, LinearEquiv.trans_apply, Basis.repr_symm_apply] - rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] - · rw [Fintype.sum_prod_type] - refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - exact congrArg _ (Basis.tensorProduct_apply leftBasis rightBasis i j) + rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ), Fintype.sum_prod_type] + · simp_rw [Basis.tensorProduct_apply] + rfl · simp /-- The coercion of `Finsupp.linearEquivFunOnFinite` to a function is the underlying @@ -235,10 +225,10 @@ lemma leftLeftToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] LeftHandedWeyl)) (M : SL *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((leftBasis.tensorProduct leftBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (leftBasis.tensorProduct leftBasis) - (leftBasis.tensorProduct leftBasis) (TensorProduct.map (leftHandedRep M) (leftHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (leftBasis.tensorProduct leftBasis) + (leftBasis.tensorProduct leftBasis) + (TensorProduct.map (leftHandedRep M) (leftHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -246,22 +236,11 @@ lemma leftLeftToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] LeftHandedWeyl)) (M : SL ((LinearMap.toMatrix leftBasis leftBasis) (leftHandedRep M)) (i, j) k) * leftLeftToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ j : Fin 2, M.1 i j * leftLeftToMatrix v j x) * M.1 j x - = ∑ x : Fin 2, ∑ x1 : Fin 2, (M.1 i x1 * leftLeftToMatrix v x1 x) * M.1 j x := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [leftBasis_ρ_apply] - rw [mul_assoc] - nth_rewrite 2 [mul_comm] - rw [← mul_assoc] + ring set_option backward.isDefEq.respectTransparency false in /-- The group action of `SL(2,ℂ)` on `dualLeftHanded ⊗ dualLeftHanded` is equivalent to @@ -277,11 +256,10 @@ lemma dualLeftdualLeftToMatrix_ρ (v : (DualLeftHandedWeyl ⊗[ℂ] DualLeftHand *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((dualLeftBasis.tensorProduct dualLeftBasis).repr v))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (dualLeftBasis.tensorProduct dualLeftBasis) - (dualLeftBasis.tensorProduct dualLeftBasis) - (TensorProduct.map (dualLeftHandedRep M) (dualLeftHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (dualLeftBasis.tensorProduct dualLeftBasis) + (dualLeftBasis.tensorProduct dualLeftBasis) + (TensorProduct.map (dualLeftHandedRep M) (dualLeftHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -289,20 +267,9 @@ lemma dualLeftdualLeftToMatrix_ρ (v : (DualLeftHandedWeyl ⊗[ℂ] DualLeftHand ((LinearMap.toMatrix dualLeftBasis dualLeftBasis) (dualLeftHandedRep M)) (i, j) k) * dualLeftdualLeftToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, (M.1)⁻¹ x1 i * - dualLeftdualLeftToMatrix v x1 x) * (M.1)⁻¹ x j - = ∑ x : Fin 2, ∑ x1 : Fin 2, ((M.1)⁻¹ x1 i * - dualLeftdualLeftToMatrix v x1 x) * (M.1)⁻¹ x j := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [dualLeftBasis_ρ_apply, transpose_apply] ring @@ -320,11 +287,10 @@ lemma leftDualLeftToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] DualLeftHandedWeyl)) *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((leftBasis.tensorProduct dualLeftBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (leftBasis.tensorProduct dualLeftBasis) - (leftBasis.tensorProduct dualLeftBasis) - (TensorProduct.map (leftHandedRep M) (dualLeftHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (leftBasis.tensorProduct dualLeftBasis) + (leftBasis.tensorProduct dualLeftBasis) + (TensorProduct.map (leftHandedRep M) (dualLeftHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -332,18 +298,9 @@ lemma leftDualLeftToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] DualLeftHandedWeyl)) ((LinearMap.toMatrix dualLeftBasis dualLeftBasis) (dualLeftHandedRep M)) (i, j) k) * leftDualLeftToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, M.1 i x1 * leftDualLeftToMatrix v x1 x) * (M.1⁻¹) x j - = ∑ x : Fin 2, ∑ x1 : Fin 2, (M.1 i x1 * leftDualLeftToMatrix v x1 x) * (M.1⁻¹) x j := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [leftBasis_ρ_apply, dualLeftBasis_ρ_apply, transpose_apply] ring @@ -361,11 +318,10 @@ lemma dualLeftLeftToMatrix_ρ (v : (DualLeftHandedWeyl ⊗[ℂ] LeftHandedWeyl)) *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((dualLeftBasis.tensorProduct leftBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (dualLeftBasis.tensorProduct leftBasis) - (dualLeftBasis.tensorProduct leftBasis) - (TensorProduct.map (dualLeftHandedRep M) (leftHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (dualLeftBasis.tensorProduct leftBasis) + (dualLeftBasis.tensorProduct leftBasis) + (TensorProduct.map (dualLeftHandedRep M) (leftHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -373,18 +329,9 @@ lemma dualLeftLeftToMatrix_ρ (v : (DualLeftHandedWeyl ⊗[ℂ] LeftHandedWeyl)) ((LinearMap.toMatrix leftBasis leftBasis) (leftHandedRep M)) (i, j) k) * dualLeftLeftToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, (M.1)⁻¹ x1 i * dualLeftLeftToMatrix v x1 x) * M.1 j x - = ∑ x : Fin 2, ∑ x1 : Fin 2, ((M.1)⁻¹ x1 i * dualLeftLeftToMatrix v x1 x) * M.1 j x:= by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [dualLeftBasis_ρ_apply, transpose_apply, leftBasis_ρ_apply] ring @@ -402,11 +349,10 @@ lemma rightRightToMatrix_ρ (v : (RightHandedWeyl ⊗[ℂ] RightHandedWeyl)) (M *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((rightBasis.tensorProduct rightBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (rightBasis.tensorProduct rightBasis) - (rightBasis.tensorProduct rightBasis) - (TensorProduct.map (rightHandedRep M) (rightHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (rightBasis.tensorProduct rightBasis) + (rightBasis.tensorProduct rightBasis) + (TensorProduct.map (rightHandedRep M) (rightHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -414,19 +360,9 @@ lemma rightRightToMatrix_ρ (v : (RightHandedWeyl ⊗[ℂ] RightHandedWeyl)) (M ((LinearMap.toMatrix rightBasis rightBasis) (rightHandedRep M)) (i, j) k) * rightRightToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, (M.1.map star) i x1 * rightRightToMatrix v x1 x) * - (M.1.map star) j x = ∑ x : Fin 2, ∑ x1 : Fin 2, - ((M.1.map star) i x1 * rightRightToMatrix v x1 x) * (M.1.map star) j x:= by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [rightBasis_ρ_apply] ring @@ -445,11 +381,10 @@ lemma dualRightDualRightToMatrix_ρ (v : (DualRightHandedWeyl ⊗[ℂ] DualRight *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((dualRightBasis.tensorProduct dualRightBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (dualRightBasis.tensorProduct dualRightBasis) - (dualRightBasis.tensorProduct dualRightBasis) - (TensorProduct.map (dualRightHandedRep M) (dualRightHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (dualRightBasis.tensorProduct dualRightBasis) + (dualRightBasis.tensorProduct dualRightBasis) + (TensorProduct.map (dualRightHandedRep M) (dualRightHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -457,19 +392,9 @@ lemma dualRightDualRightToMatrix_ρ (v : (DualRightHandedWeyl ⊗[ℂ] DualRight ((LinearMap.toMatrix dualRightBasis dualRightBasis) (dualRightHandedRep M)) (i, j) k) * dualRightDualRightToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, (↑M)⁻¹ᴴ i x1 * dualRightDualRightToMatrix v x1 x) * - (↑M)⁻¹ᴴ j x = ∑ x : Fin 2, ∑ x1 : Fin 2, - ((↑M)⁻¹ᴴ i x1 * dualRightDualRightToMatrix v x1 x) * (↑M)⁻¹ᴴ j x := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [dualRightBasis_ρ_apply] ring @@ -487,11 +412,10 @@ lemma rightDualRightToMatrix_ρ (v : (RightHandedWeyl ⊗[ℂ] DualRightHandedWe *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((rightBasis.tensorProduct dualRightBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (rightBasis.tensorProduct dualRightBasis) - (rightBasis.tensorProduct dualRightBasis) - (TensorProduct.map (rightHandedRep M) (dualRightHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (rightBasis.tensorProduct dualRightBasis) + (rightBasis.tensorProduct dualRightBasis) + (TensorProduct.map (rightHandedRep M) (dualRightHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -499,19 +423,9 @@ lemma rightDualRightToMatrix_ρ (v : (RightHandedWeyl ⊗[ℂ] DualRightHandedWe ((LinearMap.toMatrix dualRightBasis dualRightBasis) (dualRightHandedRep M)) (i, j) k) * rightDualRightToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, (M.1.map star) i x1 * rightDualRightToMatrix v x1 x) - * (↑M)⁻¹ᴴ j x = ∑ x : Fin 2, ∑ x1 : Fin 2, - ((M.1.map star) i x1 * rightDualRightToMatrix v x1 x) * (↑M)⁻¹ᴴ j x := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [rightBasis_ρ_apply, dualRightBasis_ρ_apply] ring @@ -529,11 +443,10 @@ lemma dualRightRightToMatrix_ρ (v : (DualRightHandedWeyl ⊗[ℂ] RightHandedWe *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((dualRightBasis.tensorProduct rightBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (dualRightBasis.tensorProduct rightBasis) - (dualRightBasis.tensorProduct rightBasis) - (TensorProduct.map (dualRightHandedRep M) (rightHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (dualRightBasis.tensorProduct rightBasis) + (dualRightBasis.tensorProduct rightBasis) + (TensorProduct.map (dualRightHandedRep M) (rightHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -541,20 +454,9 @@ lemma dualRightRightToMatrix_ρ (v : (DualRightHandedWeyl ⊗[ℂ] RightHandedWe ((LinearMap.toMatrix rightBasis rightBasis) (rightHandedRep M)) (i, j) k) * dualRightRightToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, - (↑M)⁻¹ᴴ i x1 * dualRightRightToMatrix v x1 x) * (M.1.map star) j x - = ∑ x : Fin 2, ∑ x1 : Fin 2, ((↑M)⁻¹ᴴ i x1 * dualRightRightToMatrix v x1 x) * - (M.1.map star) j x := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [dualRightBasis_ρ_apply, rightBasis_ρ_apply] ring @@ -571,11 +473,10 @@ lemma dualLeftDualRightToMatrix_ρ (v : (DualLeftHandedWeyl ⊗[ℂ] DualRightHa *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((dualLeftBasis.tensorProduct dualRightBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (dualLeftBasis.tensorProduct dualRightBasis) - (dualLeftBasis.tensorProduct dualRightBasis) - (TensorProduct.map (dualLeftHandedRep M) (dualRightHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (dualLeftBasis.tensorProduct dualRightBasis) + (dualLeftBasis.tensorProduct dualRightBasis) + (TensorProduct.map (dualLeftHandedRep M) (dualRightHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -583,19 +484,9 @@ lemma dualLeftDualRightToMatrix_ρ (v : (DualLeftHandedWeyl ⊗[ℂ] DualRightHa ((LinearMap.toMatrix dualRightBasis dualRightBasis) (dualRightHandedRep M)) (i, j) k) * dualLeftDualRightToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, (M.1)⁻¹ x1 i * dualLeftDualRightToMatrix v x1 x) * - (M.1)⁻¹ᴴ j x = ∑ x : Fin 2, ∑ x1 : Fin 2, - ((M.1)⁻¹ x1 i * dualLeftDualRightToMatrix v x1 x) * (M.1)⁻¹ᴴ j x:= by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [dualLeftBasis_ρ_apply, transpose_apply, dualRightBasis_ρ_apply] ring @@ -611,11 +502,10 @@ lemma leftRightToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] RightHandedWeyl)) (M : *ᵥ ((Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2)) ((leftBasis.tensorProduct rightBasis).repr (v)))) · apply congrArg - have h1 := (LinearMap.toMatrix_mulVec_repr (leftBasis.tensorProduct rightBasis) - (leftBasis.tensorProduct rightBasis) - (TensorProduct.map (leftHandedRep M) (rightHandedRep M)) v) - simp only [coe_linearEquivFunOnFinite] - rw [h1] + simpa only [coe_linearEquivFunOnFinite] using + (LinearMap.toMatrix_mulVec_repr (leftBasis.tensorProduct rightBasis) + (leftBasis.tensorProduct rightBasis) + (TensorProduct.map (leftHandedRep M) (rightHandedRep M)) v).symm rw [TensorProduct.toMatrix_map] funext i j change ∑ k, ((kroneckerMap (fun x1 x2 => x1 * x2) @@ -623,18 +513,9 @@ lemma leftRightToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] RightHandedWeyl)) (M : ((LinearMap.toMatrix rightBasis rightBasis) (rightHandedRep M)) (i, j) k) * leftRightToMatrix v k.1 k.2) = _ rw [Fintype.sum_prod_type] - simp_rw [kroneckerMap_apply, Matrix.mul_apply] - have h1 : ∑ x : Fin 2, (∑ x1 : Fin 2, M.1 i x1 * leftRightToMatrix v x1 x) * (M.1)ᴴ x j - = ∑ x : Fin 2, ∑ x1 : Fin 2, (M.1 i x1 * leftRightToMatrix v x1 x) * (M.1)ᴴ x j := by - congr - funext x - rw [Finset.sum_mul] - rw [h1] + simp_rw [kroneckerMap_apply, Matrix.mul_apply, Finset.sum_mul] rw [Finset.sum_comm] - congr - funext x - congr - funext x1 + refine Finset.sum_congr rfl fun x _ => Finset.sum_congr rfl fun x1 _ => ?_ simp only [leftBasis_ρ_apply, rightBasis_ρ_apply] rw [Matrix.conjTranspose] simp only [RCLike.star_def, map_apply, transpose_apply] @@ -649,75 +530,55 @@ lemma leftRightToMatrix_ρ (v : (LeftHandedWeyl ⊗[ℂ] RightHandedWeyl)) (M : lemma leftLeftToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (leftHandedRep M) (leftHandedRep M) (leftLeftToMatrix.symm v) = leftLeftToMatrix.symm (M.1 * v * (M.1)ᵀ) := by - have h1 := leftLeftToMatrix_ρ (leftLeftToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, leftLeftToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma dualLeftdualLeftToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (dualLeftHandedRep M) (dualLeftHandedRep M) (dualLeftdualLeftToMatrix.symm v) = dualLeftdualLeftToMatrix.symm ((M.1⁻¹)ᵀ * v * (M.1⁻¹)) := by - have h1 := dualLeftdualLeftToMatrix_ρ (dualLeftdualLeftToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, dualLeftdualLeftToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma leftDualLeftToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (leftHandedRep M) (dualLeftHandedRep M) (leftDualLeftToMatrix.symm v) = leftDualLeftToMatrix.symm (M.1 * v * (M.1⁻¹)) := by - have h1 := leftDualLeftToMatrix_ρ (leftDualLeftToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, leftDualLeftToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma dualLeftLeftToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (dualLeftHandedRep M) (leftHandedRep M) (dualLeftLeftToMatrix.symm v) = dualLeftLeftToMatrix.symm ((M.1⁻¹)ᵀ * v * (M.1)ᵀ) := by - have h1 := dualLeftLeftToMatrix_ρ (dualLeftLeftToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, dualLeftLeftToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma rightRightToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (rightHandedRep M) (rightHandedRep M) (rightRightToMatrix.symm v) = rightRightToMatrix.symm ((M.1.map star) * v * ((M.1.map star))ᵀ) := by - have h1 := rightRightToMatrix_ρ (rightRightToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, rightRightToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma dualRightDualRightToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (dualRightHandedRep M) (dualRightHandedRep M) (dualRightDualRightToMatrix.symm v) = dualRightDualRightToMatrix.symm (((M.1⁻¹).conjTranspose) * v * ((M.1⁻¹).conjTranspose)ᵀ) := by - have h1 := dualRightDualRightToMatrix_ρ (dualRightDualRightToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, dualRightDualRightToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma rightDualRightToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (rightHandedRep M) (dualRightHandedRep M) (rightDualRightToMatrix.symm v) = rightDualRightToMatrix.symm ((M.1.map star) * v * (((M.1⁻¹).conjTranspose)ᵀ)) := by - have h1 := rightDualRightToMatrix_ρ (rightDualRightToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, rightDualRightToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma dualRightRightToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (dualRightHandedRep M) (rightHandedRep M) (dualRightRightToMatrix.symm v) = dualRightRightToMatrix.symm (((M.1⁻¹).conjTranspose) * v * (M.1.map star)ᵀ) := by - have h1 := dualRightRightToMatrix_ρ (dualRightRightToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, dualRightRightToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma dualLeftDualRightToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (dualLeftHandedRep M) (dualRightHandedRep M) (dualLeftDualRightToMatrix.symm v) = dualLeftDualRightToMatrix.symm ((M.1⁻¹)ᵀ * v * ((M.1⁻¹).conjTranspose)ᵀ) := by - have h1 := dualLeftDualRightToMatrix_ρ (dualLeftDualRightToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, dualLeftDualRightToMatrix_ρ, LinearEquiv.apply_symm_apply] lemma leftRightToMatrix_ρ_symm (v : Matrix (Fin 2) (Fin 2) ℂ) (M : SL(2,ℂ)) : TensorProduct.map (leftHandedRep M) (rightHandedRep M) (leftRightToMatrix.symm v) = leftRightToMatrix.symm (M.1 * v * (M.1)ᴴ) := by - have h1 := leftRightToMatrix_ρ (leftRightToMatrix.symm v) M - simp only [LinearEquiv.apply_symm_apply] at h1 - rw [← h1, LinearEquiv.symm_apply_apply] + rw [LinearEquiv.eq_symm_apply, leftRightToMatrix_ρ, LinearEquiv.apply_symm_apply] open Lorentz @@ -729,14 +590,10 @@ lemma dualLeftDualRightToMatrix_ρ_symm_selfAdjoint (v : Matrix (Fin 2) (Fin 2) rw [dualLeftDualRightToMatrix_ρ_symm] apply congrArg simp only [SL2C.toSelfAdjointMap_apply_coe, SpecialLinearGroup.coe_inv, - SpecialLinearGroup.coe_transpose] + SpecialLinearGroup.coe_transpose, SL2C.inverse_coe] congr 1 - · rw [SL2C.inverse_coe] - simp only [SpecialLinearGroup.coe_inv] - rw [@adjugate_transpose] - · rw [SL2C.inverse_coe] - simp only [SpecialLinearGroup.coe_inv] - rw [← @adjugate_transpose] + · rw [adjugate_transpose] + · rw [← adjugate_transpose] rfl lemma leftRightToMatrix_ρ_symm_selfAdjoint (v : Matrix (Fin 2) (Fin 2) ℂ) diff --git a/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean b/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean index d75f86b86..0dc461f99 100644 --- a/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean +++ b/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean @@ -69,7 +69,7 @@ abbrev ComponentIdx {n : ℕ} {S : TensorSpecies k C G V basisIdx rep b} lemma ComponentIdx.congr_right {n : ℕ} {c : Fin n → C} (b : ComponentIdx (S := S) c) (i j : Fin n) (h : i = j) : b i = basisIdxCongr (by simp [h]) (b j) := by subst h - simp [basisIdxCongr] + rfl /-- Casting of a `ComponentIdx` through equivalent color maps. -/ def ComponentIdx.cast {n m : ℕ} {c : Fin n → C} {cm : Fin m → C} diff --git a/Physlib/Relativity/Tensors/Constructors.lean b/Physlib/Relativity/Tensors/Constructors.lean index b37d9ddf6..b7d4acba0 100644 --- a/Physlib/Relativity/Tensors/Constructors.lean +++ b/Physlib/Relativity/Tensors/Constructors.lean @@ -63,9 +63,8 @@ lemma fromSingleT_symm_pure {c : C} (p : Pure S ![c]) : lemma fromSingleT_eq_pureT {c : C} (x : V c) : fromSingleT (S := S) x = Pure.toTensor (fun 0 => x : Pure S ![c]) := by change _ = Pure.toTensor (Pure.fromSingleP x) - obtain ⟨p, rfl⟩ := Pure.fromSingleP (S := S).symm.surjective x - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, LinearEquiv.apply_symm_apply] - rw [← fromSingleT_symm_pure] + apply fromSingleT.symm.injective + rw [fromSingleT_symm_pure] simp lemma actionT_fromSingleT {c : C} (x : V c) (g : G) : @@ -134,28 +133,21 @@ lemma fromPairT_eq_pure {c1 c2 : C} (x : V c1) (y : V c2) : rw [fromPairT_tmul, fromSingleT_eq_pureT, fromSingleT_eq_pureT, prodT_pure, permT_pure] congr funext i - fin_cases i - · rfl - · rfl + fin_cases i <;> rfl lemma actionT_fromPairT {c1 c2 : C} (x : V c1 ⊗[k]V c2) (g : G) : g • fromPairT (S := S) x = fromPairT (TensorProduct.map (rep c1 g) (rep c2 g) x) := by - let P (x : V c1 ⊗[k] V c2) : Prop := - g • fromPairT (S := S) x = fromPairT (TensorProduct.map (rep c1 g) - (rep c2 g) x) - change P x - apply TensorProduct.induction_on - · simp [P] - · intro x y - simp [P] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x y => + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, map_tmul] rw [fromPairT_tmul, ← permT_equivariant, ← prodT_equivariant, actionT_fromSingleT, actionT_fromSingleT] rfl - · intro x y hx hy - simp [P, hx, hy] + | add x y hx hy => simp [hx, hy] lemma fromPairT_map_right {c1 c2 c2' : C} (h :c2 = c2') (x : V c1 ⊗[k] V c2) : @@ -179,25 +171,16 @@ lemma fromPairT_comm {c1 c2 : C} fromPairT (TensorProduct.comm k _ _ x) = permT ![1, 0] (And.intro (by decide) (fun i => by fin_cases i <;> simp)) (fromPairT (S := S) x) := by - let P (x : V c1 ⊗[k] V c2) : Prop := - fromPairT (TensorProduct.comm k _ _ x) = - permT ![1, 0] (And.intro (by decide) (fun i => by fin_cases i <;> simp)) - (fromPairT (S := S) x) - change P x - apply TensorProduct.induction_on - · simp [P] - · intro x y - simp [P] - rw [fromPairT_tmul, fromPairT_tmul] - rw [prodT_swap] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x y => + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, comm_tmul, Fin.isValue] + rw [fromPairT_tmul, fromPairT_tmul, prodT_swap] simp only [Nat.succ_eq_add_one, Nat.reduceAdd, permT_permT, CompTriple.comp_eq, Fin.isValue] congr ext i - fin_cases i - · rfl - · rfl - · intro x y hx hy - simp [P, hx, hy] + fin_cases i <;> rfl + | add x y hx hy => simp [hx, hy] /-! @@ -218,17 +201,7 @@ lemma fromSingleTContrFromPairT_tmul {c c2 : C} (x : V c) (y1 : V (S.τ c)) (y2 : V c2) : fromSingleTContrFromPairT x (y1 ⊗ₜ[k] y2) = S.contr c (x ⊗ₜ[k] y1) • fromSingleT y2 := by - rw [fromSingleTContrFromPairT] - conv_lhs => - enter [2, 2, 2] - change (x ⊗ₜ[k] y1) ⊗ₜ[k] y2 - conv_lhs => - enter [2, 2] - change (S.contr c) (x ⊗ₜ[k] y1) ⊗ₜ[k] y2 - conv_lhs => - enter [2] - change (S.contr c) (x ⊗ₜ[k] y1) • y2 - simp + simp [fromSingleTContrFromPairT] lemma fromSingleT_contr_fromPairT_tmul {c c2 : C} (x : V c) (y1 : V (S.τ c)) (y2 : V c2) : @@ -265,10 +238,9 @@ lemma fromSingleT_contr_fromPairT_tmul {c c2 : C} rw [permT_permT] conv_rhs => rw [contrT_permT] - apply permT_congr - · ext i - simp - · rfl + refine permT_congr ?_ rfl + ext i + simp · rw [contrT_fromSingleT_fromSingleT] simp only [map_smul, LinearMap.smul_apply] rw [fromSingleTContrFromPairT_tmul] @@ -276,10 +248,9 @@ lemma fromSingleT_contr_fromPairT_tmul {c c2 : C} congr 1 rw [prodT_swap, permT_permT] simp only [Fin.isValue, Nat.add_zero, CompTriple.comp_eq, prodT_default_right, permT_permT] - apply permT_congr - · ext i - simp - · rfl + refine permT_congr ?_ rfl + ext i + simp lemma contrT_fromSingleT_fromPairT {c c2 : C} (x : V c) @@ -287,20 +258,13 @@ lemma contrT_fromSingleT_fromPairT {c c2 : C} contrT 1 0 1 (by simp; rfl) (prodT (fromSingleT x) (fromPairT y)) = permT id (by simp; rfl) (fromSingleTContrFromPairT x y) := by - /- The proof -/ - let P (y : V (S.τ c) ⊗[k] V c2) : Prop := - contrT 1 0 1 (by simp; rfl) - (prodT (fromSingleT x) (fromPairT y)) = - permT id (by simp; rfl) (fromSingleTContrFromPairT x y) - change P y - apply TensorProduct.induction_on - · simp only [fromSingleTContrFromPairT, map_zero, tmul_zero, P] - · intro y1 y2 - exact fromSingleT_contr_fromPairT_tmul x y1 y2 - · intro x y hx hy - simp only [P, fromSingleTContrFromPairT] at hx hy ⊢ + induction y using TensorProduct.induction_on with + | zero => simp only [fromSingleTContrFromPairT, map_zero, tmul_zero] + | tmul y1 y2 => exact fromSingleT_contr_fromPairT_tmul x y1 y2 + | add a b ha hb => + simp only [fromSingleTContrFromPairT] at ha hb ⊢ simp only [tmul_add, map_add] - rw [hx, hy] + rw [ha, hb] /-! @@ -325,21 +289,7 @@ noncomputable def fromPairTContr {c c1 c2 : C}(x : V c1 ⊗[k] V c) (y : V (S.τ lemma fromPairTContr_tmul_tmul {c c1 c2 : C} (x1 : V c1) (x2 : V c) (y1 : V (S.τ c)) (y2 : V c2) : fromPairTContr (x1 ⊗ₜ[k] x2) (y1 ⊗ₜ[k] y2) = (S.contr c) (x2 ⊗ₜ[k] y1) • fromPairT (x1 ⊗ₜ[k] y2) := by - rw [fromPairTContr] - conv_lhs => - enter [2, 2, 2, 2] - change x1 ⊗ₜ[k] (x2 ⊗ₜ[k] (y1 ⊗ₜ[k] y2)) - conv_lhs => - enter [2, 2, 2] - change x1 ⊗ₜ[k] ((x2 ⊗ₜ[k] y1) ⊗ₜ[k] y2) - conv_lhs => - enter [2, 2] - change x1 ⊗ₜ[k] ((S.contr c) (x2 ⊗ₜ[k] y1) ⊗ₜ[k] y2) - conv_lhs => - enter [2] - change x1 ⊗ₜ[k] (((S.contr c) (x2 ⊗ₜ[k] y1) :k) • y2) - rw [tmul_smul (R := k) (R' := k)] - simp + simp [fromPairTContr, tmul_smul] lemma fromPairT_contr_fromPairT_eq_fromPairTContr_tmul (c c1 c2 : C) (x1 : V c1) (x2 : V c) (y1 : V (S.τ c)) @@ -351,9 +301,7 @@ lemma fromPairT_contr_fromPairT_eq_fromPairTContr_tmul (c c1 c2 : C) Pure.contrP, contrT_pure, prodT_pure] congr funext i - fin_cases i - · rfl - · rfl + fin_cases i <;> rfl lemma fromPairT_contr_fromPairT_eq_fromPairTContr (c c1 c2 : C) (x : V c1 ⊗[k] V c) @@ -361,33 +309,22 @@ lemma fromPairT_contr_fromPairT_eq_fromPairTContr (c c1 c2 : C) contrT 2 1 2 (by simp; rfl) (prodT (fromPairT x) (fromPairT y)) = permT id (by simp; exact ⟨rfl, rfl⟩) (fromPairTContr x y) := by - /- The proof-/ - let P (x : V c1 ⊗[k] V c) - (y : V (S.τ c) ⊗[k] V c2) : Prop := - contrT 2 1 2 (by simp; rfl) - (prodT (fromPairT x) (fromPairT y)) = - permT id (by simp; exact ⟨rfl, rfl⟩) (fromPairTContr x y) - let P1 (x : V c1 ⊗[k] V c) := P x y - change P1 x - apply TensorProduct.induction_on - · simp only [fromPairTContr, map_zero, LinearMap.zero_apply, zero_tmul, P1, P] - · intro x1 x2 - let P2 (y : V (S.τ c) ⊗[k] V c2) : Prop := - P (x1 ⊗ₜ x2) y - change P2 y - apply TensorProduct.induction_on - · simp only [fromPairTContr, map_zero, tmul_zero, P2, P] - · intro y1 y2 - simp only [Nat.reduceAdd, Nat.succ_eq_add_one, Fin.isValue, P2, P] + induction x using TensorProduct.induction_on with + | zero => simp only [fromPairTContr, map_zero, LinearMap.zero_apply, zero_tmul] + | tmul x1 x2 => + induction y using TensorProduct.induction_on with + | zero => simp only [fromPairTContr, map_zero, tmul_zero] + | tmul y1 y2 => + simp only [Nat.reduceAdd, Nat.succ_eq_add_one, Fin.isValue] exact fromPairT_contr_fromPairT_eq_fromPairTContr_tmul c c1 c2 x1 x2 y1 y2 - · intro x y hx hy - simp only [P2, P, fromPairTContr] at hx hy ⊢ + | add a b ha hb => + simp only [fromPairTContr] at ha hb ⊢ simp only [tmul_add, map_add] - rw [← hx, ← hy] - · intro x y hx hy - simp only [P1, P, fromPairTContr] at hx hy ⊢ + rw [← ha, ← hb] + | add a b ha hb => + simp only [fromPairTContr] at ha hb ⊢ simp only [add_tmul, map_add] - rw [← hx, ← hy] + rw [← ha, ← hb] simp lemma fromPairT_basis_repr {c c1 : C} @@ -395,16 +332,11 @@ lemma fromPairT_basis_repr {c c1 : C} (φ : ComponentIdx ![c, c1]) : (basis ![c, c1]).repr (fromPairT (S := S) x) φ = (Basis.tensorProduct (b c) (b c1)).repr x (φ 0, φ 1) := by - let P (x : (V c ⊗[k] V c1)) := - (basis ![c, c1]).repr - (fromPairT (S := S) x) φ = - (Basis.tensorProduct (b c) (b c1)).repr x (φ 0, φ 1) - change P x - apply TensorProduct.induction_on - · simp [P] - · intro x y + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x y => simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, Basis.tensorProduct_repr_tmul_apply, - smul_eq_mul, P] + smul_eq_mul] conv_lhs => left right @@ -415,8 +347,7 @@ lemma fromPairT_basis_repr {c c1 : C} simp [Pure.component] rw [mul_comm] rfl - · intro x y hx hy - simp_all [P] + | add x y hx hy => simp_all lemma fromPairT_apply_basis_repr {c c1 : C} (b0 : basisIdx c) (b1 : basisIdx c1) : @@ -492,27 +423,18 @@ lemma actionT_fromTripleT {c1 c2 c3 : C} (x : V c1 ⊗[k] (V c2 ⊗[k] V c3)) (g : G) : g • fromTripleT (S := S) x = fromTripleT (TensorProduct.map (rep c1 g) (TensorProduct.map (rep c2 g) (rep c3 g)) x) := by - let P (x : V c1 ⊗[k] (V c2 ⊗[k] V c3)) : Prop := - g • fromTripleT (S := S) x = fromTripleT (TensorProduct.map (rep c1 g) - (TensorProduct.map (rep c2 g) (rep c3 g)) x) - change P x - apply TensorProduct.induction_on - · simp [P] - · intro x y - let P1 (y : V c2 ⊗[k] V c3) : Prop := - P (x ⊗ₜ[k] y) - change P1 y - apply TensorProduct.induction_on - · simp [P1, P] - · intro y z - simp [P1, P] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x yz => + induction yz using TensorProduct.induction_on with + | zero => simp + | tmul y z => + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, map_tmul] rw [fromTripleT_tmul, fromTripleT_tmul] rw [← permT_equivariant, ← prodT_equivariant, ← prodT_equivariant] simp [← actionT_fromSingleT] - · intro x y hx hy - simp [P1, P, hx, hy, tmul_add] - · intro x y hx hy - simp [P, hx, hy] + | add a b ha hb => simp [ha, hb, tmul_add] + | add a b ha hb => simp [ha, hb] lemma fromTripleT_basis_repr {c c1 c2 : C} (x : V c ⊗[k] (V c1 ⊗[k] V c2)) @@ -520,20 +442,14 @@ lemma fromTripleT_basis_repr {c c1 c2 : C} (basis ![c, c1, c2]).repr (fromTripleT (S := S) x) φ = (Basis.tensorProduct (b c) (Basis.tensorProduct (b c1) (b c2))).repr x (φ 0, φ 1, φ 2) := by - let P (x : V c ⊗[k] (V c1 ⊗[k] V c2)) := (basis ![c, c1, c2]).repr (fromTripleT x) φ = - (Basis.tensorProduct (b c) (Basis.tensorProduct (b c1) (b c2))).repr x - (φ 0, φ 1, φ 2) - change P x - apply TensorProduct.induction_on - · simp [P] - · intro x y - let P1 (y : V c1 ⊗[k] V c2) : Prop := - P (x ⊗ₜ[k] y) - change P1 y - apply TensorProduct.induction_on - · simp [P1, P] - · intro y z - simp [P1, P] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x yz => + induction yz using TensorProduct.induction_on with + | zero => simp + | tmul y z => + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, + Basis.tensorProduct_repr_tmul_apply, smul_eq_mul] rw [fromTripleT_tmul] rw [fromSingleT_eq_pureT, fromSingleT_eq_pureT, fromSingleT_eq_pureT] rw [prodT_pure, prodT_pure, permT_pure] @@ -544,15 +460,14 @@ lemma fromTripleT_basis_repr {c c1 c2 : C} enter [1] rw [mul_comm] rfl - · intro y1 y2 hx hy + | add y1 y2 hx hy => simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, - Basis.tensorProduct_repr_tmul_apply, smul_eq_mul, P1, P] at hx hy + Basis.tensorProduct_repr_tmul_apply, smul_eq_mul] at hx hy simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, Basis.tensorProduct_repr_tmul_apply, smul_eq_mul, tmul_add, map_add, Finsupp.coe_add, - Pi.add_apply, add_mul, P1, P] + Pi.add_apply] rw [hx, hy] - · intro x y hx hy - simp_all [P] + | add a b ha hb => simp_all lemma fromTripleT_apply_basis {c c1 c2 : C} (b0 : basisIdx c) (b1 : basisIdx c1) diff --git a/Physlib/Relativity/Tensors/Product.lean b/Physlib/Relativity/Tensors/Product.lean index 16c405c4b..f32c5d7ab 100644 --- a/Physlib/Relativity/Tensors/Product.lean +++ b/Physlib/Relativity/Tensors/Product.lean @@ -243,9 +243,7 @@ lemma Pure.prodP_zero_right {n} {c : Fin n → C} {c1 : Fin 0 → C} (p : Pure S c) (p0 : Pure S c1) : prodP p p0 = permP id IsReindexing.append_zero_right p := by ext i - obtain ⟨j, hi⟩ := finSumFinEquiv.surjective (Fin.cast (by rfl) i : Fin (n + 0)) - simp only [Nat.add_zero, Fin.cast_eq_self] at hi - subst hi + obtain ⟨j, rfl⟩ := finSumFinEquiv.surjective i rw (transparency := .instances) [prodP_apply_finSumFinEquiv] match j with | Sum.inl j => rfl @@ -460,9 +458,7 @@ lemma prodT_basis {n1 n2} {c : Fin n1 → C} {c1 : Fin n2 → C} (b : ComponentIdx c) (b1 : ComponentIdx (S := S) c1) : (basis c b).prodT (basis c1 b1) = (Pure.basisVector _ (ComponentIdx.prod.symm (b, b1))).toTensor := by - rw [basis_apply, basis_apply, prodT_pure] - congr - rw [Pure.prodP_basisVector] + rw [basis_apply, basis_apply, prodT_pure, Pure.prodP_basisVector] lemma prodT_basis' {n1 n2} {c : Fin n1 → C} {c1 : Fin n2 → C} (b : ComponentIdx c) (b1 : ComponentIdx (S := S) c1) : @@ -548,10 +544,7 @@ lemma basis_prod_eq {n1 n2} {c : Fin n1 → C} {c1 : Fin n2 → C} : congr funext i obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i - rw [ComponentIdx.prod] - match i with - | Sum.inl i => simp - | Sum.inr i => simp + rcases i with i | i <;> simp [ComponentIdx.prod] lemma prodT_basis_repr_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} (t : Tensor S c) (t1 : Tensor S c1) @@ -562,9 +555,7 @@ lemma prodT_basis_repr_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} apply induction_on_pure (t := t) · apply induction_on_pure (t := t1) · intro p p1 - rw [prodT_pure] - rw [basis_repr_pure, basis_repr_pure, basis_repr_pure] - rw [Pure.prodP_component] + simp only [prodT_pure, basis_repr_pure, Pure.prodP_component] · intro r t hp p simp only [basis_repr_pure, map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul] at hp ⊢ rw [hp] @@ -589,25 +580,13 @@ lemma prodT_basis_repr_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} lemma prodT_equivariant {n1 n2} {c : Fin n1 → C} {c1 : Fin n2 → C} (g : G) (t : S.Tensor c) (t1 : S.Tensor c1) : prodT (g • t) (g • t1) = g • prodT t t1 := by - let P (t : S.Tensor c) := prodT (g • t) (g • t1) = g • prodT t t1 - change P t - apply induction_on_pure - · intro p - let P (t1 : S.Tensor c1) := prodT (g • p.toTensor) (g • t1) = g • prodT p.toTensor t1 - change P t1 - apply induction_on_pure - · intro q - simp only [P] - rw [prodT_pure, actionT_pure, actionT_pure, prodT_pure, actionT_pure] - simp - · intro r t h1 - simp_all only [actionT_smul, map_smul, P] - · intro t1 t2 h1 h2 - simp_all only [actionT_add, map_add, P] - · intro r t h1 - simp_all only [actionT_smul, map_smul, LinearMap.smul_apply, P] - · intro t1 t2 h1 h2 - simp_all only [actionT_add, map_add, LinearMap.add_apply, P] + induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 + · induction' t1 using induction_on_pure with q r t ht t1 t2 ht1 ht2 + · simp [prodT_pure, actionT_pure] + · simp [actionT_smul, map_smul, ht] + · simp [map_add, ht1, ht2] + · simp [actionT_smul, map_smul, ht] + · simp [map_add, ht1, ht2] /-! @@ -619,19 +598,12 @@ lemma prodT_default_right {n} {c : Fin n → C} {c1 : Fin 0 → C} (t : S.Tensor c) : prodT t (Pure.toTensor default : S.Tensor c1) = permT id (IsReindexing.append_zero_right) t := by - let P (t : S.Tensor c) := prodT t (Pure.toTensor default : S.Tensor c1) - = permT id (IsReindexing.append_zero_right) t - change P t - apply induction_on_pure - · intro p - simp only [Nat.add_zero, P] + induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 + · simp only [Nat.add_zero] rw (transparency := .instances) [prodT_pure] - rw [Pure.prodP_zero_right] - rw [permT_pure] - · intro r t h1 - simp_all only [map_smul, LinearMap.smul_apply, P] - · intro t1 t2 h1 h2 - simp_all only [map_add, LinearMap.add_apply, P] + rw [Pure.prodP_zero_right, permT_pure] + · simp [map_smul, ht] + · simp [map_add, ht1, ht2] lemma prodT_zero_right {n} {c : Fin n → C} {c1 : Fin 0 → C} (t : S.Tensor c) (t1 : S.Tensor c1) : @@ -654,7 +626,7 @@ lemma prodT_swap {n n1} {c : Fin n → C} {c1 : Fin n1 → C} (t : S.Tensor c) ( prodT t t1 = permT _ IsReindexing.append_swap (prodT t1 t) := by induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 · induction' t1 using induction_on_pure with q r t ht t1 t2 ht1 ht2 - · simp [prodT_pure, permT_pure, permT_pure, prodT_pure, Pure.prodP_swap p q] + · simp [prodT_pure, permT_pure, Pure.prodP_swap p q] · simp [map_smul, ht] · simp [map_add, ht1, ht2] · simp [ht] @@ -672,9 +644,7 @@ lemma prodT_permT_left {n n'} {c : Fin n → C} {c' : Fin n' → C} prodT (permT σ h t) t2 = permT _ (h.append_congr_left c2) (prodT t t2) := by induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 · induction' t2 using induction_on_pure with q r t ht t1 t2 ht1 ht2 - · simp only [prodT_pure, permT_pure, permT_pure, prodT_pure] - congr - simp + · simp [prodT_pure, permT_pure] · simp only [map_smul, ht] · simp only [map_add, ht1, ht2] · simp [ht] @@ -692,9 +662,7 @@ lemma prodT_permT_right {n n'} {c : Fin n → C} {c' : Fin n' → C} prodT t2 (permT σ h t) = permT _ (h.append_congr_right c2) (prodT t2 t) := by induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 · induction' t2 using induction_on_pure with q r t ht t1 t2 ht1 ht2 - · simp only [prodT_pure, permT_pure, permT_pure, prodT_pure] - congr - simp + · simp [prodT_pure, permT_pure] · simp [map_smul, ht] · simp [map_add, ht1, ht2] · simp [ht] @@ -712,7 +680,7 @@ lemma prodT_assoc {n n1 n2} {c : Fin n → C} induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 · induction' t1 using induction_on_pure with q r t ht t1 t2 ht1 ht2 · induction' t2 using induction_on_pure with q r t ht t1 t2 ht1 ht2 - · simp [prodT_pure, permT_pure, permT_pure, prodT_pure, Pure.prodP_assoc] + · simp [prodT_pure, permT_pure, Pure.prodP_assoc] · simp [ht] · simp [ht1, ht2] · simp [ht] @@ -732,7 +700,7 @@ lemma prodT_assoc' {n n1 n2} {c : Fin n → C} induction' t using induction_on_pure with p r t ht t1 t2 ht1 ht2 · induction' t1 using induction_on_pure with q r t ht t1 t2 ht1 ht2 · induction' t2 using induction_on_pure with q r t ht t1 t2 ht1 ht2 - · simp [prodT_pure, permT_pure, permT_pure, prodT_pure, Pure.prodP_assoc'] + · simp [prodT_pure, permT_pure, Pure.prodP_assoc'] · simp [ht] · simp [ht1, ht2] · simp [ht] diff --git a/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean b/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean index 8ce430965..121be7d1c 100644 --- a/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean +++ b/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean @@ -84,7 +84,7 @@ def colorToComplex (c : realLorentzTensor.Color) : complexLorentzTensor.Color := lemma repDim_colorToComplex {c : realLorentzTensor.Color} : complexLorentzTensor.repDim (colorToComplex c) = 4 := by - cases c <;> simp [colorToComplex] + cases c <;> rfl /-- `simp` helper: reduce `match c j` after a case split on `c j` (avoids dependent `rw` / `Pi.smul_apply`). -/ @@ -109,7 +109,7 @@ lemma colorToComplex_comp_eq_match {n} (c : Fin n → realLorentzTensor.Color) ( (match c j with | .up => complexLorentzTensor.Color.up | .down => complexLorentzTensor.Color.down) := by - rcases hc : c j with _ | _ <;> simp [colorToComplex, hc, Function.comp_apply] + cases hc : c j <;> simp [colorToComplex, hc] /-- The complexification of the component index of a real Lorentz tensor to a complex Lorentz tensor. -/ @@ -169,9 +169,8 @@ lemma toComplex_eq_sum_basis {n} (c : Fin n → realLorentzTensor.Color) (v : toComplex v = ∑ i, (Tensor.basis (S := realLorentzTensor) c).repr v (ComponentIdx.complexify.symm i) • Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) i := by - simp only [toComplex, LinearMap.coe_mk, AddHom.coe_mk] rw [← Equiv.sum_comp ComponentIdx.complexify] - simp + exact Finset.sum_congr rfl fun i _ => by simp /-- The representation of `toComplex v` in the complexified basis equals the real representation coerced to complex. -/ @@ -180,54 +179,10 @@ lemma toComplex_repr {n} {c : Fin n → realLorentzTensor.Color} (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c)).repr (toComplex v) i.complexify = ↑((Tensor.basis (S := realLorentzTensor) c).repr v i) := by - -- Expand toComplex v in the complexified basis - rw [toComplex_eq_sum_basis] - -- `repr` commutes with finite sums of tensors; then push the Finsupp evaluation into the sum - rw [map_sum] - simp only [Finsupp.coe_finsetSum, Finset.sum_apply] - -- The sum has only one non-zero term (when k = i.complexify) - rw [Fintype.sum_eq_single i.complexify] - · -- Case k = i.complexify: show the term equals ↑(repr v i) - have hsmul : - ((Tensor.basis (S := realLorentzTensor) c).repr v - (ComponentIdx.complexify.symm (ComponentIdx.complexify i))) • - Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) - (ComponentIdx.complexify i) = - (↑((Tensor.basis (S := realLorentzTensor) c).repr v - (ComponentIdx.complexify.symm (ComponentIdx.complexify i))) : ℂ) • - Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) - (ComponentIdx.complexify i) := - (Complex.coe_smul _ _).symm - rw [hsmul] - have hm := - LinearEquiv.map_smul - (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c)).repr - (↑((Tensor.basis (S := realLorentzTensor) c).repr v - (ComponentIdx.complexify.symm (ComponentIdx.complexify i))) : ℂ) - (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) - (ComponentIdx.complexify i)) - simp_rw [hm] - simp only [Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, Basis.repr_self, Finsupp.single_apply] - simp only [Equiv.symm_apply_apply ComponentIdx.complexify, ite_true, mul_one] - · -- Case k ≠ i.complexify: show the term equals 0 - intro k hk - have hsmul : - ((Tensor.basis (S := realLorentzTensor) c).repr v (ComponentIdx.complexify.symm k)) • - Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) k = - (↑((Tensor.basis (S := realLorentzTensor) c).repr v (ComponentIdx.complexify.symm k)) : ℂ) • - Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) k := - (Complex.coe_smul _ _).symm - rw [hsmul] - have hm := - LinearEquiv.map_smul (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c)).repr - (↑((Tensor.basis (S := realLorentzTensor) c).repr v (ComponentIdx.complexify.symm k)) : ℂ) - (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c) k) - simp_rw [hm] - simp only [Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, Basis.repr_self, Finsupp.single_apply] - split_ifs with h - · exfalso - exact hk h - · rw [mul_zero] + rw [toComplex_eq_sum_basis, map_sum] + simp only [← Complex.coe_smul, map_smul, Finsupp.coe_finsetSum, Finset.sum_apply, + Finsupp.smul_apply, Basis.repr_self, Finsupp.single_apply, smul_eq_mul, mul_ite, mul_one, + mul_zero, Finset.sum_ite_eq', Finset.mem_univ, if_true, Equiv.symm_apply_apply] /-- `toComplex` sends basis elements to basis elements. -/ @[simp] @@ -235,17 +190,8 @@ lemma toComplex_basis {n} {c : Fin n → realLorentzTensor.Color} (i : ComponentIdx (S := realLorentzTensor) c) : toComplex (c := c) ((Tensor.basis (S := realLorentzTensor) c) i) = (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c)) i.complexify := by - classical simp only [toComplex, LinearMap.coe_mk, AddHom.coe_mk] - rw [Basis.repr_self] - simp_rw [Finsupp.single_apply] - -- collapse the sum: only the `i`-term survives - refine (Fintype.sum_eq_single i ?_).trans ?_ - · intro j hj - have hij : i ≠ j := Ne.symm hj - simp [hij] - · -- now the remaining term is the `i`-term - simp + simp [Finsupp.single_apply, ite_smul] /-- `toComplex` on a pure basis vector. -/ @[simp] @@ -254,11 +200,7 @@ lemma toComplex_pure_basisVector {n} {c : Fin n → realLorentzTensor.Color} toComplex (c := c) (Pure.basisVector c b |>.toTensor) = (Pure.basisVector (colorToComplex ∘ c) b.complexify).toTensor := by - classical - -- rewrite pure basis vector back to tensor basis, use `toComplex_basis`, then rewrite back - rw [← Tensor.basis_apply (S := realLorentzTensor) (c := c) b] - rw [toComplex_basis (c := c) b] - rw [Tensor.basis_apply (S := complexLorentzTensor) (c := (colorToComplex ∘ c)) b.complexify] + simp [← Tensor.basis_apply] lemma toComplex_map_smul {n} (c : Fin n → realLorentzTensor.Color) (r : ℝ) (t : ℝT(3, c)) : toComplex (c := c) (r • t) = (Complex.ofReal r) • toComplex (c := c) t := @@ -267,26 +209,18 @@ lemma toComplex_map_smul {n} (c : Fin n → realLorentzTensor.Color) (r : ℝ) ( @[simp] lemma toComplex_eq_zero_iff {n} (c : Fin n → realLorentzTensor.Color) (v : ℝT(3, c)) : toComplex v = 0 ↔ v = 0 := by - rw [toComplex_eq_sum_basis] - have h1 : LinearIndependent ℂ - (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c)) := - Basis.linearIndependent _ - rw [Fintype.linearIndependent_iff] at h1 constructor · intro h apply (Tensor.basis (S := realLorentzTensor) c).repr.injective ext i - have h2 := h1 (fun i => ((Tensor.basis c).repr v) (ComponentIdx.complexify.symm i)) h - i.complexify - simpa using h2 - · intro h - subst h + simpa [h] using (toComplex_repr v i).symm + · rintro rfl simp /-- The map `toComplex` is injective. -/ lemma toComplex_injective {n} (c : Fin n → realLorentzTensor.Color) : Function.Injective (toComplex (c := c)) := - (injective_iff_map_eq_zero' toComplex).mpr (fun v => toComplex_eq_zero_iff c v) + (injective_iff_map_eq_zero' toComplex).mpr (toComplex_eq_zero_iff c) open Matrix open MatrixGroups @@ -342,38 +276,23 @@ noncomputable def toComplexVector (c : realLorentzTensor.Color) : lemma toComplexVector_up_eq_inclCongrRealLorentz (v : Lorentz.ContrMod 3) : toComplexVector Color.up v = Lorentz.inclCongrRealLorentz v := by - calc - toComplexVector Color.up v - = ∑ i, v.toFin1dℝ i • Lorentz.complexContrBasis i := by - simp [toComplexVector, Lorentz.contrBasis_repr_apply, - Lorentz.complexContrBasisFin4, Lorentz.ContrMod.toFin1dℝ_eq_val] - rfl - _ = ∑ i, v.toFin1dℝ i • Lorentz.inclCongrRealLorentz - (Lorentz.ContrMod.stdBasis i) := by - simp only [Lorentz.complexContrBasis_of_real] - _ = Lorentz.inclCongrRealLorentz - (∑ i, v.toFin1dℝ i • Lorentz.ContrMod.stdBasis i) := by - rw [map_sum] - simp only [LinearMap.map_smulₛₗ, Complex.ofRealHom_eq_coe, Complex.coe_smul] - _ = Lorentz.inclCongrRealLorentz v := by - rw [← Lorentz.ContrMod.stdBasis_decomp v] + trans ∑ i, v.toFin1dℝ i • Lorentz.complexContrBasis i + · simp [toComplexVector, Lorentz.contrBasis_repr_apply, + Lorentz.complexContrBasisFin4, Lorentz.ContrMod.toFin1dℝ_eq_val] + · conv_rhs => rw [Lorentz.ContrMod.stdBasis_decomp v] + simp only [map_sum, LinearMap.map_smulₛₗ, Complex.ofRealHom_eq_coe, Complex.coe_smul, + Lorentz.complexContrBasis_of_real] + rfl lemma toComplexVector_down_eq_inclCoRealLorentz (v : Lorentz.CoMod 3) : toComplexVector Color.down v = Lorentz.inclCoRealLorentz v := by - calc - toComplexVector Color.down v - = ∑ i, v.toFin1dℝ i • Lorentz.complexCoBasis i := by - simp [toComplexVector, Lorentz.coBasis_repr_apply, Lorentz.complexCoBasisFin4] - rfl - _ = ∑ i, v.toFin1dℝ i • Lorentz.inclCoRealLorentz - (Lorentz.CoMod.stdBasis i) := by - simp only [Lorentz.complexCoBasis_of_real] - _ = Lorentz.inclCoRealLorentz - (∑ i, v.toFin1dℝ i • Lorentz.CoMod.stdBasis i) := by - rw [map_sum] - simp only [LinearMap.map_smulₛₗ, Complex.ofRealHom_eq_coe, Complex.coe_smul] - _ = Lorentz.inclCoRealLorentz v := by - rw [← Lorentz.CoMod.stdBasis_decomp v] + trans ∑ i, v.toFin1dℝ i • Lorentz.complexCoBasis i + · simp [toComplexVector, Lorentz.coBasis_repr_apply, Lorentz.complexCoBasisFin4] + rfl + · conv_rhs => rw [Lorentz.CoMod.stdBasis_decomp v] + simp only [map_sum, LinearMap.map_smulₛₗ, Complex.ofRealHom_eq_coe, Complex.coe_smul, + Lorentz.complexCoBasis_of_real] + rfl /-- The function which turns a real pure tensor into a complex one. -/ noncomputable def toComplexPure {c : Fin n → Color} (p : Pure realLorentzTensor c) : @@ -467,35 +386,22 @@ lemma actionP_toComplexPure {n : ℕ} (c : Fin n → Color) (p : Pure realLorent generalize c i = c at * fin_cases c · simp_all [P, b, b', colorToComplex] - calc - (Lorentz.ContrℂModule.SL2CRep Λ) ((toComplexVector Color.up) p) - = (Lorentz.ContrℂModule.SL2CRep Λ) (Lorentz.inclCongrRealLorentz p) := by - exact congrArg (Lorentz.ContrℂModule.SL2CRep Λ) - (toComplexVector_up_eq_inclCongrRealLorentz p) - _ = Lorentz.inclCongrRealLorentz (Lorentz.ContrMod.rep (toLorentzGroup Λ) p) := by - rw [Lorentz.inclCongrRealLorentz_ρ] - _ = (toComplexVector Color.up) ((Lorentz.ContrMod.rep (toLorentzGroup Λ)) p) := by - exact (toComplexVector_up_eq_inclCongrRealLorentz - ((Lorentz.ContrMod.rep (toLorentzGroup Λ)) p)).symm + exact ((congrArg (Lorentz.ContrℂModule.SL2CRep Λ) + (toComplexVector_up_eq_inclCongrRealLorentz p)).trans + (Lorentz.inclCongrRealLorentz_ρ Λ p)).trans + (toComplexVector_up_eq_inclCongrRealLorentz _).symm · simp_all [P, b, b', colorToComplex] - calc - (Lorentz.CoℂModule.SL2CRep Λ) ((toComplexVector Color.down) p) - = (Lorentz.CoℂModule.SL2CRep Λ) (Lorentz.inclCoRealLorentz p) := by - exact congrArg (Lorentz.CoℂModule.SL2CRep Λ) - (toComplexVector_down_eq_inclCoRealLorentz p) - _ = Lorentz.inclCoRealLorentz (Lorentz.CoMod.rep (toLorentzGroup Λ) p) := by - rw [Lorentz.inclCoRealLorentz_ρ] - _ = (toComplexVector Color.down) ((Lorentz.CoMod.rep (toLorentzGroup Λ)) p) := by - exact (toComplexVector_down_eq_inclCoRealLorentz - ((Lorentz.CoMod.rep (toLorentzGroup Λ)) p)).symm + exact ((congrArg (Lorentz.CoℂModule.SL2CRep Λ) + (toComplexVector_down_eq_inclCoRealLorentz p)).trans + (Lorentz.inclCoRealLorentz_ρ Λ p)).trans + (toComplexVector_down_eq_inclCoRealLorentz _).symm lemma toComplex_pure {n : ℕ} (c : Fin n → Color) (p : Pure realLorentzTensor c) : toComplex p.toTensor = (toComplexPure p).toTensor := by apply (Tensor.basis _).repr.injective ext φ obtain ⟨φ, rfl⟩ := TensorSpecies.Tensor.ComponentIdx.complexify.surjective φ - rw [basis_repr_pure, toComplex_repr, toComplexPure_component] - simp + simp [toComplex_repr, toComplexPure_component] /-! @@ -513,11 +419,7 @@ lemma toComplex_equivariant {n} {c : Fin n → realLorentzTensor.Color} Λ • (toComplex v) = toComplex (Lorentz.SL2C.toLorentzGroup Λ • v) := by induction' v using induction_on_pure with p r t h t1 t2 · rw [actionT_pure, toComplex_pure, actionT_pure, actionP_toComplexPure, toComplex_pure] - · simp - rw [← h] - change Λ • (r : ℂ) • toComplex t = _ - rw [actionT_smul] - rfl + · simpa [← h] using actionT_smul (g := Λ) (r := (r : ℂ)) (t := toComplex t) · simp_all /-! @@ -534,10 +436,8 @@ by the operator `permT`. @[simp] lemma isReindexing_colorToComplex {n m : ℕ} {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) : - IsReindexing (colorToComplex ∘ c) (colorToComplex ∘ c1) σ := by - refine And.intro h.1 ?_ - intro i - simpa [Function.comp_apply] using congrArg colorToComplex (h.2 i) + IsReindexing (colorToComplex ∘ c) (colorToComplex ∘ c1) σ := + ⟨h.1, fun i => congrArg colorToComplex (h.2 i)⟩ /-- `permT` sends basis vectors to basis vectors. -/ @[simp] lemma permT_basis_real {n m : ℕ} @@ -547,7 +447,6 @@ by the operator `permT`. permT (S := realLorentzTensor) σ h ((Tensor.basis (S := realLorentzTensor) c) b) = (Tensor.basis (S := realLorentzTensor) c1) (fun j => b (σ j)) := by - classical simp [Tensor.basis_apply, permT_pure, Pure.permP_basisVector] @[simp] lemma permT_basis_complex {n m : ℕ} @@ -563,7 +462,6 @@ by the operator `permT`. -- if one has `h.2 j : c1 j = c (σ j)`, then replace it with `(h.2 j).symm` simpa using congrArg (fun col => complexLorentzTensor.repDim col) (h.2 j)) (b (σ j))) := by - classical simp [Tensor.basis_apply, permT_pure, Pure.permP_basisVector, basisIdxCongr_eq_cast] /-- The map `toComplex` commutes with permT. -/ @@ -575,35 +473,15 @@ lemma permT_toComplex {n m : ℕ} = permT (S := complexLorentzTensor) σ (isReindexing_colorToComplex (c := c) (c1 := c1) h) (toComplex (c := c) t) := by - classical - let h' : IsReindexing (colorToComplex ∘ c) (colorToComplex ∘ c1) σ := - isReindexing_colorToComplex (c := c) (c1 := c1) h - let P : ℝT(3, c) → Prop := fun t => - toComplex (permT (S := realLorentzTensor) σ h t) - = - permT (S := complexLorentzTensor) σ h' (toComplex (c := c) t) - change P t - apply induction_on_basis - · intro b - dsimp [P, h'] - - -- permT on (real/complex) basis + toComplex on basis - simp (config := { failIfUnchanged := false }) - [permT_basis_real, permT_basis_complex, toComplex_basis] - - -- index equality + induction t using induction_on_basis with + | h b => + simp only [permT_basis_real, toComplex_basis, permT_basis_complex] apply congrArg (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c1)) funext j simp [TensorSpecies.Tensor.ComponentIdx.complexify, colorToComplex, Function.comp_apply] - · simp [P] - · intro r t ht - dsimp [P] at ht ⊢ - refine (by - simp [map_smul, ht]) - · intro t1 t2 h1 h2 - dsimp [P] at h1 h2 ⊢ - refine (by - simp [map_add, h1, h2]) + | hzero => simp + | hsmul r t ht => simp [map_smul, ht] + | hadd t1 t2 h1 h2 => simp [map_add, h1, h2] /-! @@ -617,30 +495,14 @@ lemma colorToComplex_append {n m : ℕ} (c : Fin n → realLorentzTensor.Color) (c1 : Fin m → realLorentzTensor.Color) : (colorToComplex ∘ Fin.append c c1) = Fin.append (colorToComplex ∘ c) (colorToComplex ∘ c1) := by funext x - -- breaking down x : Fin (n+m) into left/right parts - refine Fin.addCases (fun i => ?_) (fun j => ?_) x - · -- left case: x = castAdd m i - -- here `simp` should expand `Fin.append` on castAdd - simp [Fin.append, Function.comp_apply] - · -- right case: x = natAdd n j - simp [Fin.append, Function.comp_apply] + refine Fin.addCases (fun i => ?_) (fun j => ?_) x <;> simp [Fin.append] lemma isReindexing_prodTColorToComplex {n m : ℕ} {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} : IsReindexing (Fin.append (colorToComplex ∘ c) (colorToComplex ∘ c1)) (colorToComplex ∘ Fin.append c c1) - (id : Fin (n + m) → Fin (n + m)) := by - -- For `σ = id`, `IsReindexing.on_id` reduces the goal to pointwise color equality. - -- Here that equality is exactly `colorToComplex_append`. - apply (IsReindexing.on_id - (c := Fin.append (colorToComplex ∘ c) (colorToComplex ∘ c1)) - (c1 := colorToComplex ∘ Fin.append c c1)).2 - intro x - -- `colorToComplex_append` states the two color functions are extensionally equal, - -- but with the sides reversed, so we use its symmetric form. - have hx := congrArg (fun f => f x) - (colorToComplex_append (c := c) (c1 := c1)).symm - simpa [Function.comp_apply] using hx + (id : Fin (n + m) → Fin (n + m)) := + ⟨Function.bijective_id, fun i => (congrFun (colorToComplex_append c c1) i).symm⟩ /-- `prodT` on the complex side, with colors written as `colorToComplex ∘ Fin.append ...`. This is `prodT` followed by a cast using `colorToComplex_append`. -/ @@ -665,9 +527,8 @@ private lemma cast_componentIdx_eq_fun {n : ℕ} (h : c' = c) (f : ComponentIdx (S := complexLorentzTensor) c') : cast (congr_arg ComponentIdx h) f = (fun x => - Fin.cast (congr_arg (fun col => complexLorentzTensor.repDim (col x)) h) (f x)) := by - funext x - exact cast_componentIdx_apply (c := c) (c' := c') h f x + Fin.cast (congr_arg (fun col => complexLorentzTensor.repDim (col x)) h) (f x)) := + funext fun x => cast_componentIdx_apply h f x /-- `complexify` commutes with `prod` of component indices. -/ @[simp] @@ -682,13 +543,8 @@ lemma complexify_prod {n m : ℕ} ComponentIdx.complexify (c := c1) b1)) := by ext x obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective x - cases i with - | inl i => - rw [ComponentIdx.complexify_apply] - simp [ComponentIdx.prod] - erw [basisIdxCongr_eq_cast] - simp - | inr j => + cases i + all_goals rw [ComponentIdx.complexify_apply] simp [ComponentIdx.prod] erw [basisIdxCongr_eq_cast] @@ -704,17 +560,15 @@ lemma prodT_toComplex {n m : ℕ} = prodTColorToComplex (c := c) (c1 := c1) (toComplex (c := c) t) (toComplex (c := c1) t1) := by - classical -- Double induction on the tensor basis: first over `t`, then over `t1`. The zero, scalar and -- additive cases follow from linearity of `prodT`, `toComplex` and `prodTColorToComplex`. induction t using induction_on_basis with | h b => induction t1 using induction_on_basis with | h b1 => - simp (config := { failIfUnchanged := false }) - [prodTColorToComplex, prodT_pure, permT_pure, Pure.prodP_basisVector, - Pure.permP_basisVector, Tensor.basis_apply, toComplex_pure_basisVector, - colorToComplex_append, basisIdxCongr_eq_cast] + simp [prodTColorToComplex, prodT_pure, permT_pure, Pure.prodP_basisVector, + Pure.permP_basisVector, Tensor.basis_apply, toComplex_pure_basisVector, + colorToComplex_append, basisIdxCongr_eq_cast] | hzero => simp [prodTColorToComplex] | hsmul r ta hta => simp [map_smul, hta, prodTColorToComplex] | hadd ta tb hta htb => simp [map_add, hta, htb, prodTColorToComplex] @@ -772,15 +626,10 @@ lemma toComplex_contrP_basisVector {n : ℕ} {c : Fin (n + 1 + 1) → realLorent rw [contrPCoeff_basis, complexLorentzTensor.contrPCoeff_basis] simp only [Function.comp_apply, ComponentIdx.complexify_apply, Nat.reduceAdd, Fin.cast_cast, Fin.cast_inj, EmbeddingLike.apply_eq_iff_eq] - simp_all only [ne_eq] - obtain ⟨left, right⟩ := h - split - next h => simp_all only [Complex.ofReal_one] - next h => simp_all only [Complex.ofReal_zero] + split <;> simp_all · -- complexify(fun k => b (succSuccAbove k)) = (complexify b) ∘ succSuccAbove - rw [Pure.dropPair_basisVector] - rw [← Tensor.basis_apply] - refine congr_arg _ (funext fun m => ComponentIdx.complexify_comp_succSuccAbove b m) + rw [Pure.dropPair_basisVector, ← Tensor.basis_apply] + exact congr_arg _ (funext fun m => ComponentIdx.complexify_comp_succSuccAbove b m) set_option backward.isDefEq.respectTransparency false in /-- The map `toComplex` commutes with `contrT`. -/ @@ -794,68 +643,17 @@ lemma contrT_toComplex {n : ℕ} And.intro h.1 (by simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) (toComplex (c := c) t) := by - classical - -- We prove the statement by induction on the tensor `t` using the tensor basis. - -- After contracting two indices, the resulting colour function lives on `Fin n`. - let c' : Fin n → realLorentzTensor.Color := c ∘ Fin.succSuccAbove i j - have hP : - ∀ t : ℝT(3, c), - toComplex (c := c') (contrT (S := realLorentzTensor) n i j h t) = - contrT (S := complexLorentzTensor) n i j - (by - -- transport the colour relation along `colorToComplex` - simpa [Function.comp_apply] using - And.intro h.1 - (by - simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) - (toComplex (c := c) t) := by - intro t - -- Work with the property as a predicate for `induction_on_basis`. - let P : ℝT(3, c) → Prop := fun t => - toComplex (c := c') (contrT (S := realLorentzTensor) n i j h t) = - contrT (S := complexLorentzTensor) n i j - (by - simpa [Function.comp_apply] using - And.intro h.1 - (by - simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) - (toComplex (c := c) t) - have hP' : P t := by - -- `induction_on_basis` over the tensor `t`. - apply - induction_on_basis - (c := c) - (P := P) - (t := t) - · -- basis case - intro b - -- (Tensor.basis c) b = (Pure.basisVector c b).toTensor; - -- then equate both sides via toComplex_contrP_basisVector. - rw [Tensor.basis_apply (S := realLorentzTensor) c b] - show toComplex (c := c') - (contrT (S := realLorentzTensor) n i j h ((Pure.basisVector c b).toTensor)) - = contrT (S := complexLorentzTensor) n i j _ - (toComplex (c := c) ((Pure.basisVector c b).toTensor)) - rw [contrT_pure (S := realLorentzTensor) (p := Pure.basisVector c b), - toComplex_pure_basisVector (c := c) b, - contrT_pure (S := complexLorentzTensor) - (p := Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b))] - exact toComplex_contrP_basisVector h b - · -- zero tensor - dsimp [P] - simp - · -- scalar multiplication - intro r t ht - dsimp [P] at ht ⊢ - refine (by - simp [map_smul, ht]) - · -- addition - intro t1 t2 h1 h2 - dsimp [P] at h1 h2 ⊢ - refine (by - simp [map_add, h1, h2]) - exact hP' - exact hP t + induction t using induction_on_basis with + | h b => + rw [Tensor.basis_apply (S := realLorentzTensor) c b, + contrT_pure (S := realLorentzTensor) (p := Pure.basisVector c b), + toComplex_pure_basisVector (c := c) b, + contrT_pure (S := complexLorentzTensor) + (p := Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b))] + exact toComplex_contrP_basisVector h b + | hzero => simp + | hsmul r t ht => simp [map_smul, ht] + | hadd t1 t2 h1 h2 => simp [map_add, h1, h2] /-! @@ -922,10 +720,7 @@ lemma toComplex_evalP_basisVector {n : ℕ} {c : Fin (n + 1) → realLorentzTens ext j; simp only [Pure.drop, Pure.basisVector, ComponentIdx.complexify_apply, Function.comp_apply] rw [hdrop'] - exact (permT_id_self (S := complexLorentzTensor) (c := colorToComplex ∘ (c ∘ i.succAbove)) - (t := (Pure.basisVector (colorToComplex ∘ (c ∘ i.succAbove)) - (ComponentIdx.complexify (c := c ∘ i.succAbove) (fun k => b' - (i.succAbove k)))).toTensor)).symm + exact (permT_id_self _).symm · simp [h] /-- The map `toComplex` commutes with `evalT`. -/ @@ -936,35 +731,17 @@ lemma evalT_toComplex {n : ℕ} ((TensorSpecies.Tensor.evalT (S := realLorentzTensor) (c := c) i b) t) = evalTColorToComplex (c := c) i b (toComplex (c := c) t) := by - classical - let c' := c ∘ i.succAbove - let P : ℝT(3, c) → Prop := fun t => - toComplex (c := c') - ((TensorSpecies.Tensor.evalT (S := realLorentzTensor) (c := c) i b) t) = - evalTColorToComplex (c := c) i b (toComplex (c := c) t) - have hP : ∀ t, P t := by - intro t - apply induction_on_basis (c := c) (P := P) (t := t) - · intro b' - rw [Tensor.basis_apply (S := realLorentzTensor) c b'] - simp only [evalTColorToComplex, P] - rw [evalT_pure (S := realLorentzTensor) (p := Pure.basisVector c b'), - toComplex_pure_basisVector (c := c) b', - evalT_pure (S := complexLorentzTensor) - (p := Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b'))] - exact toComplex_evalP_basisVector i b b' - · dsimp [P] - simp only [evalTColorToComplex, map_zero] - · intro r t' ht' - dsimp [P] at ht' ⊢ - rw [LinearMap.map_smul, toComplex_map_smul (c ∘ i.succAbove) r - ((evalT (S := realLorentzTensor) i b) t'), - ht', toComplex_map_smul (c := c) r t'] - simp only [evalTColorToComplex, LinearMap.map_smul] - · intro t1 t2 h1 h2 - dsimp [P] at h1 h2 ⊢ - rw [LinearMap.map_add, map_add, h1, h2] - simp only [evalTColorToComplex, LinearMap.map_add] - exact hP t + induction t using induction_on_basis with + | h b' => + rw [Tensor.basis_apply (S := realLorentzTensor) c b'] + simp only [evalTColorToComplex] + rw [evalT_pure (S := realLorentzTensor) (p := Pure.basisVector c b'), + toComplex_pure_basisVector (c := c) b', + evalT_pure (S := complexLorentzTensor) + (p := Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b'))] + exact toComplex_evalP_basisVector i b b' + | hzero => simp [evalTColorToComplex] + | hsmul r t' ht' => simp [evalTColorToComplex, ht'] + | hadd t1 t2 h1 h2 => simp [evalTColorToComplex, h1, h2] end realLorentzTensor diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/Representation.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/Representation.lean index d0a2d609b..e0a852daf 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/Representation.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/Representation.lean @@ -54,37 +54,26 @@ lemma rep_apply_basis {d} (μ : Fin 1 ⊕ Fin d) (Λ : LorentzGroup d) : simp [rep_apply_eq_sum, apply_sum] lemma rep_toMatrix (d : ℕ) (Λ : LorentzGroup d) : - LinearMap.toMatrix basis basis (rep Λ) = Λ.1 := by - simp only [rep, MonoidHom.coe_mk, OneHom.coe_mk] - exact (LinearEquiv.eq_symm_apply (LinearMap.toMatrix basis basis)).mp rfl + LinearMap.toMatrix basis basis (rep Λ) = Λ.1 := + (LinearEquiv.eq_symm_apply (LinearMap.toMatrix basis basis)).mp rfl -lemma rep_injective (d : ℕ) (Λ : LorentzGroup d) : Function.Injective (rep Λ) := by - intro v1 v2 h - rw [rep_apply_eq_mulVec, rep_apply_eq_mulVec] at h - exact Matrix.mulVec_injective_of_isUnit (isUnit_of_invertible Λ.1) h +lemma rep_injective (d : ℕ) (Λ : LorentzGroup d) : Function.Injective (rep Λ) := + fun _ _ h => Matrix.mulVec_injective_of_isUnit (isUnit_of_invertible Λ.1) h -lemma rep_surjective (d : ℕ) (Λ : LorentzGroup d) : Function.Surjective (rep Λ) := by - intro v - use Λ⁻¹ *ᵥ v - rw [rep_apply_eq_mulVec] - simp +lemma rep_surjective (d : ℕ) (Λ : LorentzGroup d) : Function.Surjective (rep Λ) := + fun v => ⟨Λ⁻¹ *ᵥ v, by simp [rep_apply_eq_mulVec]⟩ lemma rep_bijective (d : ℕ) (Λ : LorentzGroup d) : Function.Bijective (rep Λ) := ⟨rep_injective d Λ, rep_surjective d Λ⟩ @[fun_prop] lemma rep_contDiff (d : ℕ) {n} (Λ : LorentzGroup d) : ContDiff ℝ n (rep Λ) := by - refine (contDiff_apply ⇑(rep Λ)).mp ?_ - intro μ + refine (contDiff_apply _).mp fun μ => ?_ simp only [rep_apply_eq_sum, smul_eq_mul] fun_prop -lemma rep_left_injective (d : ℕ) : Function.Injective (rep (d := d)) := by - intro Λ Λ' h - apply LorentzGroup.eq_of_mulVec_eq - intro v - rw [← rep_apply_eq_mulVec, ← rep_apply_eq_mulVec] - exact LinearMap.congr_fun h v +lemma rep_left_injective (d : ℕ) : Function.Injective (rep (d := d)) := + fun _ _ h => LorentzGroup.eq_of_mulVec_eq (LinearMap.congr_fun h) end Vector diff --git a/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean b/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean index e1f7f1918..3bccaca7a 100644 --- a/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean +++ b/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean @@ -150,8 +150,7 @@ lemma schwartzMap_mul_iteratedFDeriv_integrable_slice_symm {d : ℕ} (n m : ℕ) obtain ⟨k, hrt, hbound, k_eq⟩ := hrt η apply Integrable.mono' (g := fun t => k * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) · apply Integrable.const_mul - convert hrt using 1 - simp + simpa using hrt · apply Continuous.aestronglyMeasurable apply Continuous.mul · fun_prop @@ -159,15 +158,11 @@ lemma schwartzMap_mul_iteratedFDeriv_integrable_slice_symm {d : ℕ} (n m : ℕ) apply Continuous.comp' apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) exact Nat.cast_le.mpr (by omega) - have hη := η.smooth' - apply hη.of_le (ENat.LEInfty.out) + exact η.smooth'.of_le ENat.LEInfty.out fun_prop · filter_upwards with t - apply le_trans _ (hbound x t) - apply le_of_eq - simp only [Nat.succ_eq_add_one, norm_mul, norm_pow, Real.norm_eq_abs] - rw [abs_of_nonneg (by positivity)] - simp + rw [Real.norm_of_nonneg (by positivity)] + exact hbound x t lemma schwartzMap_integrable_slice_symm {d : ℕ} (i : Fin d.succ) (η : 𝓢(Space d.succ, ℝ)) (x : Space d) : Integrable (fun r => η ((slice i).symm (r, x))) volume := by @@ -193,13 +188,11 @@ lemma schwartzMap_fderiv_integrable_slice_symm {d : ℕ} (η : 𝓢(Space d.succ (slice i).symm.toContinuousLinearMap.comp (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) (ContinuousLinearMap.id ℝ (Space d))) := by - rw [fderiv_fun_comp, DifferentiableAt.fderiv_prodMk (by fun_prop) (by fun_prop)] - · simp only [fderiv_slice_symm, fderiv_fun_const, Pi.zero_apply, fderiv_fun_id] - · fun_prop - · fun_prop + ext x2 + simp [fderiv_slice_symm_right_apply] rw [norm_iteratedFDeriv_one, fderiv_fun_comp _ _ (by fun_prop), heq] · exact ContinuousLinearMap.opNorm_comp_le _ _ - · exact (η.smooth'.differentiable (by simp)).differentiableAt + · exact η.differentiableAt @[fun_prop] lemma schwartzMap_fderiv_left_integrable_slice_symm {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) (x : Space d) @@ -209,10 +202,7 @@ lemma schwartzMap_fderiv_left_integrable_slice_symm {d : ℕ} (η : 𝓢(Space d enter [r] simp only [Nat.succ_eq_add_one, one_mul] change fderiv ℝ (η ∘ fun r => ((slice i).symm (r, x))) r 1 - rw [fderiv_comp _ (by - apply Differentiable.differentiableAt - exact η.smooth'.differentiable (by simp)) - (by fun_prop)] + rw [fderiv_comp _ η.differentiableAt (by fun_prop)] simp only [Nat.succ_eq_add_one, ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_slice_symm_left_apply] change (SchwartzMap.evalCLM ℝ (Space d.succ) ℝ (((slice i).symm (1, 0)))).comp @@ -224,9 +214,7 @@ lemma schwartzMap_fderiv_left_integrable_slice_symm {d : ℕ} (η : 𝓢(Space d lemma schwartzMap_iteratedFDeriv_norm_slice_symm_integrable {n} {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) (x : Space d) (i : Fin d.succ) : Integrable (fun r => ‖iteratedFDeriv ℝ n ⇑η (((slice i).symm (r, x)))‖) volume := by - convert schwartzMap_mul_iteratedFDeriv_integrable_slice_symm n 0 η x i using 1 - funext t - simp + simpa using schwartzMap_mul_iteratedFDeriv_integrable_slice_symm n 0 η x i @[fun_prop] lemma schwartzMap_iteratedFDeriv_slice_symm_integrable {n} {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) @@ -238,8 +226,7 @@ lemma schwartzMap_iteratedFDeriv_slice_symm_integrable {n} {d : ℕ} (η : 𝓢( apply Continuous.comp' apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) exact Nat.cast_le.mpr (by omega) - have hη := η.smooth' - apply hη.of_le (ENat.LEInfty.out) + exact η.smooth'.of_le ENat.LEInfty.out fun_prop /-! @@ -258,9 +245,7 @@ lemma continuous_schwartzMap_slice_integral {d} (i : Fin d.succ) (η : 𝓢(Spac filter_upwards with t simpa using hbound x t · apply Integrable.const_mul - convert hrt using 1 - funext t - simp + simpa using hrt · filter_upwards with t fun_prop @@ -281,10 +266,10 @@ lemma schwartzMap_slice_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Space d.succ, intro t x dsimp only [F, F'] refine DifferentiableAt.hasFDerivAt ?_ - exact ((η.smooth'.differentiable (by simp)).comp (by fun_prop)).differentiableAt + exact (η.differentiable.comp (by fun_prop)).differentiableAt obtain ⟨rt, hrt⟩ := schwartzMap_slice_bound (m := 0) (n := 1) (d := d) i obtain ⟨k, hrt, hbound, k_eq⟩ := hrt η - suffices h1 : HasFDerivAt (fun x => ∫ (a : ℝ), F x a) (∫ (a : ℝ), F' x₀ a) x₀ by exact h1 + show HasFDerivAt (fun x => ∫ (a : ℝ), F x a) (∫ (a : ℝ), F' x₀ a) x₀ apply hasFDerivAt_integral_of_dominated_of_fderiv_le (bound := fun t => (k * ‖(slice i).symm.toContinuousLinearMap.comp (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) (ContinuousLinearMap.id ℝ (Space d)))‖) @@ -292,8 +277,7 @@ lemma schwartzMap_slice_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Space d.succ, · exact Filter.univ_mem' (hF (F x₀ 0)) · filter_upwards with x fun_prop - · simp [F] - exact schwartzMap_integrable_slice_symm i η x₀ + · simpa [F] using schwartzMap_integrable_slice_symm i η x₀ · simp [F'] apply Continuous.aestronglyMeasurable refine Continuous.fderiv_one ?_ ?_ @@ -310,21 +294,17 @@ lemma schwartzMap_slice_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Space d.succ, (slice i).symm.toContinuousLinearMap.comp (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) (ContinuousLinearMap.id ℝ (Space d))) := by - rw [fderiv_fun_comp, DifferentiableAt.fderiv_prodMk (by fun_prop) (by fun_prop)] - · simp only [fderiv_slice_symm, fderiv_fun_const, Pi.zero_apply, fderiv_fun_id] - · fun_prop - · fun_prop + ext x2 + simp [fderiv_slice_symm_right_apply] rw [norm_iteratedFDeriv_one, fderiv_fun_comp _ _ (by fun_prop), heq] · exact ContinuousLinearMap.opNorm_comp_le _ _ - · exact (η.smooth'.differentiable (by simp)).differentiableAt + · exact η.differentiableAt refine le_trans hb ?_ rw [mul_right_comm] gcongr simpa using hbound x r · apply Integrable.const_mul - convert hrt using 1 - funext t - simp + simpa using hrt · filter_upwards with t intro x _ exact hF t x @@ -381,7 +361,7 @@ lemma schwartzMap_slice_integral_contDiff {d : ℕ} (n : ℕ) (η : 𝓢(Space d simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_slice_symm_right_apply, Nat.succ_eq_add_one] rw [SchwartzMap.lineDerivOp_apply_eq_fderiv] - · exact (η.smooth'.differentiable (by simp)).differentiableAt + · exact η.differentiableAt fun_prop rw [hl2] apply ih @@ -491,7 +471,6 @@ lemma schwartzMap_mul_pow_slice_integral_iteratedFDeriv_norm_le {d : ℕ} (n m : generalize hk : 2 ^ (rt + m, n).1 * ((Finset.Iic (rt + m, n)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η = k' at * subst k_eq - have hk' : 0 ≤ k := by rw [← hk]; positivity calc _ _ ≤ ‖x‖ ^ m * ((∫ (r : ℝ), ‖iteratedFDeriv ℝ n η ((slice i).symm (r, x))‖) * ‖(slice i).symm.toContinuousLinearMap.comp @@ -512,8 +491,7 @@ lemma schwartzMap_mul_pow_slice_integral_iteratedFDeriv_norm_le {d : ℕ} (n m : · apply Integrable.const_mul fun_prop · fun_prop - · refine Pi.le_def.mpr ?_ - intro t + · intro t apply mul_le_mul_of_nonneg _ (by rfl) (by positivity) (by positivity) refine pow_le_pow_left₀ (by positivity) ?_ m simp @@ -525,11 +503,8 @@ lemma schwartzMap_mul_pow_slice_integral_iteratedFDeriv_norm_le {d : ℕ} (n m : · fun_prop · apply Integrable.const_mul exact hrt - · refine Pi.le_def.mpr ?_ - intro t - convert hbound x t using 1 - · rfl - · simp + · intro t + simpa using hbound x t apply le_of_eq rw [MeasureTheory.integral_const_mul] ring @@ -623,7 +598,7 @@ lemma distDeriv_constantSliceDist_same {M : Type} [NormedAddCommGroup M] [Normed congr funext r rw [basis_self_eq_slice, fderiv_fun_slice_symm_left_apply] - exact η.differentiable.differentiableAt + exact η.differentiableAt _ = ∫ (r : ℝ), (fun r => 1) r * fderiv ℝ (fun r => η ((slice i).symm (r, x))) r 1 := by simp _ = - ∫ (r : ℝ), fderiv ℝ (fun t => 1) r 1 * (fun r => η ((slice i).symm (r, x))) r := by rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] @@ -647,13 +622,12 @@ lemma distDeriv_constantSliceDist_succAbove {M : Type} [NormedAddCommGroup M] [N ext x simp [sliceSchwartz_apply] change ∫ (r : ℝ), fderiv ℝ η _ _ = fderiv ℝ (fun x => ∫ (r : ℝ), η _) _ _ - rw [(schwartzMap_slice_integral_hasFDerivAt η i x).fderiv] - rw [ContinuousLinearMap.integral_apply] + rw [(schwartzMap_slice_integral_hasFDerivAt η i x).fderiv, ContinuousLinearMap.integral_apply] congr rw [basis_succAbove_eq_slice] funext r rw [fderiv_fun_slice_symm_right_apply] - · exact η.differentiable.differentiableAt + · exact η.differentiableAt · exact schwartzMap_fderiv_integrable_slice_symm η x i end Space diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean b/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean index b0b16689f..dc8161afd 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean @@ -93,9 +93,7 @@ lemma deriv_eq_fderiv_basis [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] lemma fderiv_eq_sum_deriv {M d} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] (f : Space d → M) (x y : Space d) : fderiv ℝ f x y = ∑ i : Fin d, y i • ∂[i] f x := by - have h1 : y = ∑ i, y i • basis i := by - exact Eq.symm (OrthonormalBasis.sum_repr basis y) - conv_lhs => rw [h1] + conv_lhs => rw [← basis.sum_repr y] simp [deriv_eq_fderiv_basis] open Manifold in @@ -111,14 +109,10 @@ open Manifold in lemma mdifferentiable_manifoldStructure_iff_differentiable {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] {f : Space d → M} {x : Space d} : MDifferentiableAt (𝓡 d) 𝓘(ℝ, M) f x ↔ DifferentiableAt ℝ f x := by - constructor - · intro h - rw [← mdifferentiableAt_iff_differentiableAt] - apply h.comp (I' := 𝓡 d) - exact (modelDiffeo.symm.mdifferentiable (WithTop.top_ne_zero)).mdifferentiableAt - · intro h - apply (mdifferentiableAt_iff_differentiableAt.mpr h).comp (I' := 𝓘(ℝ, Space d)) - exact (modelDiffeo.mdifferentiable (WithTop.top_ne_zero)).mdifferentiableAt + refine ⟨fun h => mdifferentiableAt_iff_differentiableAt.mp <| h.comp (I' := 𝓡 d) x + (modelDiffeo.symm.mdifferentiable WithTop.top_ne_zero).mdifferentiableAt, + fun h => (mdifferentiableAt_iff_differentiableAt.mpr h).comp (I' := 𝓘(ℝ, Space d)) x + (modelDiffeo.mdifferentiable WithTop.top_ne_zero).mdifferentiableAt⟩ TODO "Make the version of the derivative described through `deriv_eq_mfderiv_manifoldStructure` the definition of `deriv` and prove the @@ -155,8 +149,7 @@ lemma deriv_eq_mfderiv_manifoldStructure {M d} [NormedAddCommGroup M] [NormedSpa @[simp] lemma deriv_const [NormedAddCommGroup M] [NormedSpace ℝ M] (m : M) (μ : Fin d) : deriv μ (fun _ => m) t = 0 := by - rw [deriv] - simp + simp [deriv] /-! @@ -169,34 +162,23 @@ lemma deriv_const [NormedAddCommGroup M] [NormedSpace ℝ M] (m : M) (μ : Fin d lemma deriv_add [NormedAddCommGroup M] [NormedSpace ℝ M] (f1 f2 : Space d → M) (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : ∂[u] (f1 + f2) = ∂[u] f1 + ∂[u] f2 := by - rw [deriv_eq_fderiv_fun] ext x - rw [fderiv_add] - rfl - repeat fun_prop + simp [deriv_eq, fderiv_add (hf1 x) (hf2 x)] /-- Derivatives on space distribute coordinate-wise over addition. -/ lemma deriv_coord_add (f1 f2 : Space d → EuclideanSpace ℝ (Fin d)) (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : (∂[u] (fun x => f1 x i + f2 x i)) = - (∂[u] (fun x => f1 x i)) + (∂[u] (fun x => f2 x i)) := by - rw [deriv_eq_fderiv_fun, deriv_eq_fderiv_fun, deriv_eq_fderiv_fun] - simp only - ext x - rw [fderiv_fun_add] - simp only [_root_.add_apply, Pi.add_apply] - repeat fun_prop + (∂[u] (fun x => f1 x i)) + (∂[u] (fun x => f2 x i)) := + deriv_add (fun x => f1 x i) (fun x => f2 x i) (by fun_prop) (by fun_prop) /-- Derivatives on space distribute over subtraction. -/ @[to_fun] lemma deriv_sub [NormedAddCommGroup M] [NormedSpace ℝ M] (f1 f2 : Space d → M) (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : ∂[u] (f1 - f2) = ∂[u] f1 - ∂[u] f2 := by - rw [deriv_eq_fderiv_fun] ext x - rw [fderiv_sub] - rfl - repeat fun_prop + simp [deriv_eq, fderiv_sub (hf1 x) (hf2 x)] /-! @@ -209,25 +191,20 @@ lemma deriv_smul [NormedAddCommGroup M] [NormedSpace ℝ M] [NontriviallyNormedF [NormedAlgebra ℝ 𝕜] [NormedSpace 𝕜 M] {c : Space d → 𝕜} {f : Space d → M} (hc : DifferentiableAt ℝ c x) (hf : DifferentiableAt ℝ f x) : ∂[u] (c • f) x = c x • ∂[u] f x + ∂[u] c x • f x := by - rw [deriv_eq_fderiv_basis, deriv_eq_fderiv_basis, deriv_eq_fderiv_basis, fderiv_smul hc hf] - rfl + simp [deriv_eq, fderiv_smul hc hf] /-- Space derivatives on scalar times function. -/ lemma deriv_const_smul [NormedAddCommGroup M] [NormedSpace ℝ M] [Semiring R] [Module R M] [SMulCommClass ℝ R M] [ContinuousConstSMul R M] {f : Space d → M} (c : R) (h : Differentiable ℝ f) : ∂[u] (c • f) = c • ∂[u] f := by - rw [deriv_eq_fderiv_fun, deriv_eq_fderiv_fun] ext x - rw [fderiv_const_smul, FunLike.coe_smul, Pi.smul_apply, Pi.smul_apply] - fun_prop + simp [deriv_eq, fderiv_const_smul (h x) c] /-- Coordinate-wise scalar multiplication on space derivatives. -/ lemma deriv_coord_smul (f : Space d → EuclideanSpace ℝ (Fin d)) (k : ℝ) (hf : Differentiable ℝ f) : - ∂[u] (fun x => k * f x i) x = k * ∂[u] (fun x => f x i) x := by - rw [deriv_eq_fderiv_basis, deriv_eq_fderiv_basis, fderiv_const_mul] - simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - fun_prop + ∂[u] (fun x => k * f x i) x = k * ∂[u] (fun x => f x i) x := + congrFun (deriv_const_smul (f := fun x => f x i) k (by fun_prop)) x /-! @@ -238,15 +215,12 @@ lemma deriv_coord_smul (f : Space d → EuclideanSpace ℝ (Fin d)) (k : ℝ) /-- Derivatives on space commute with one another. -/ lemma deriv_commute [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Space d → M) (hf : ContDiff ℝ 2 f) : ∂[u] (∂[v] f) = ∂[v] (∂[u] f) := by - rw [deriv_eq_fderiv_fun, deriv_eq_fderiv_fun, deriv_eq_fderiv_fun, deriv_eq_fderiv_fun] + simp only [deriv_eq_fderiv_fun] ext x rw [fderiv_clm_apply, fderiv_clm_apply] simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, ContinuousLinearMap.flip_apply] - rw [IsSymmSndFDerivAt.eq] - apply ContDiffAt.isSymmSndFDerivAt - exact ContDiff.contDiffAt hf - simp only [minSmoothness_of_isRCLikeNormedField, le_refl] + rw [(hf.contDiffAt.isSymmSndFDerivAt (by simp)).eq] repeat fun_prop /-! @@ -258,31 +232,21 @@ lemma deriv_commute [NormedAddCommGroup M] [NormedSpace ℝ M] @[simp] lemma deriv_component_same (μ : Fin d) (x : Space d) : ∂[μ] (fun x => x μ) x = 1 := by - conv_lhs => - enter [2, x] - rw [← Space.coord_apply μ x] - change deriv μ (Space.coordCLM μ) x = 1 + simp only [← Space.coord_apply, ← Space.coordCLM_apply] simp only [deriv_eq, ContinuousLinearMap.fderiv] simp [Space.coordCLM, Space.coord] lemma deriv_component_diff (μ ν : Fin d) (x : Space d) (h : μ ≠ ν) : (deriv μ (fun x => x ν) x) = 0 := by - conv_lhs => - enter [2, x] - rw [← Space.coord_apply _ x] - change deriv μ (Space.coordCLM ν) x = 0 - simp [deriv_eq, ContinuousLinearMap.fderiv] + simp only [← Space.coord_apply, ← Space.coordCLM_apply] + simp only [deriv_eq, ContinuousLinearMap.fderiv] simpa [Space.coordCLM, Space.coord, basis_apply] using h lemma deriv_component (μ ν : Fin d) (x : Space d) : (deriv ν (fun x => x μ) x) = if ν = μ then 1 else 0 := by - by_cases h' : ν = μ - · subst h' - simp - · rw [deriv_component_diff ν μ] - simp only [right_eq_ite_iff, zero_ne_one, imp_false] - simpa using h' - simpa using h' + obtain rfl | h' := eq_or_ne ν μ + · simp + · simp [deriv_component_diff ν μ x h', h'] /-! @@ -292,13 +256,8 @@ lemma deriv_component (μ ν : Fin d) (x : Space d) : lemma deriv_component_sq {d : ℕ} {ν μ : Fin d} (x : Space d) : (deriv ν (fun x => (x μ) ^ 2) x) = if ν = μ then 2 * x μ else 0:= by - rw [deriv_eq_fderiv_basis] - rw [fderiv_fun_pow] - simp only [Nat.add_one_sub_one, pow_one, nsmul_eq_mul, Nat.cast_ofNat, - FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [← deriv_eq_fderiv_basis, deriv_component] - simp only [mul_ite, mul_one, mul_zero] - fun_prop + rw [deriv_eq, fderiv_fun_pow 2 (eval_differentiable μ x)] + simp [← deriv_eq, deriv_component, mul_ite] /-! @@ -311,23 +270,16 @@ lemma deriv_euclid {d ν μ} {f : Space d → EuclideanSpace ℝ (Fin n)} deriv ν (fun x => f x μ) x = deriv ν (fun x => f x) x μ := by rw [deriv_eq_fderiv_basis] change fderiv ℝ (EuclideanSpace.proj μ ∘ fun x => f x) x (basis ν) = _ - rw [fderiv_comp] - · simp [-EuclideanSpace.coe_proj] - rw [← deriv_eq_fderiv_basis] - · fun_prop - · fun_prop + rw [fderiv_comp x (EuclideanSpace.proj μ).differentiableAt (hf x)] + simp [-EuclideanSpace.coe_proj, ← deriv_eq_fderiv_basis] lemma deriv_lorentz_vector {d ν μ} {f : Space d → Lorentz.Vector d} (hf : Differentiable ℝ f) (x : Space d) : deriv ν (fun x => f x μ) x = deriv ν (fun x => f x) x μ := by rw [deriv_eq_fderiv_basis] change fderiv ℝ (Lorentz.Vector.coordCLM μ ∘ fun x => f x) x (basis ν) = _ - rw [fderiv_comp] - · simp - rw [← deriv_eq_fderiv_basis] - rfl - · fun_prop - · fun_prop + rw [fderiv_comp x (Lorentz.Vector.coordCLM μ).differentiableAt (hf x)] + simp [← deriv_eq_fderiv_basis, Lorentz.Vector.coordCLM_apply] /-! @@ -341,9 +293,8 @@ lemma deriv_lorentz_vector {d ν μ} {f : Space d → Lorentz.Vector d} -/ @[fun_prop] -lemma norm_sq_differentiable : Differentiable ℝ (fun x : Space d => ‖x‖ ^ 2) := by - simp [Space.norm_sq_eq] - fun_prop +lemma norm_sq_differentiable : Differentiable ℝ (fun x : Space d => ‖x‖ ^ 2) := + (contDiff_norm_sq ℝ).differentiable one_ne_zero /-! @@ -353,17 +304,7 @@ lemma norm_sq_differentiable : Differentiable ℝ (fun x : Space d => ‖x‖ ^ lemma deriv_norm_sq (x : Space d) (i : Fin d) : deriv i (fun x => ‖x‖ ^ 2) x = 2 * x i := by - simp [Space.norm_sq_eq] - rw [deriv_eq_fderiv_basis] - rw [fderiv_fun_sum] - simp only [FunLike.coe_sum, Finset.sum_apply] - conv_lhs => - enter [2, j] - rw [← deriv_eq_fderiv_basis] - simp - simp [deriv_component_sq] - intro i hi - fun_prop + simp [deriv_eq, fderiv_norm_sq_apply] /-! @@ -382,42 +323,41 @@ open InnerProductSpace /-- The inner product is differentiable. -/ @[fun_prop] lemma inner_differentiable {d : ℕ} : - Differentiable ℝ (fun y : Space d => ⟪y, y⟫_ℝ) := by - simp only [inner_self_eq_norm_sq_to_K, RCLike.ofReal_real_eq_id, id_eq] - fun_prop + Differentiable ℝ (fun y : Space d => ⟪y, y⟫_ℝ) := + differentiable_id.inner ℝ differentiable_id @[fun_prop] lemma inner_differentiableAt {d : ℕ} (x : Space d) : - DifferentiableAt ℝ (fun y : Space d => ⟪y, y⟫_ℝ) x := by - apply inner_differentiable.differentiableAt + DifferentiableAt ℝ (fun y : Space d => ⟪y, y⟫_ℝ) x := + inner_differentiable x @[fun_prop] lemma inner_apply_differentiableAt {d : ℕ} [NormedAddCommGroup M] [NormedSpace ℝ M] {f : M → Space d} {g : M → Space d} (x : M) (hf : DifferentiableAt ℝ f x) (hg : DifferentiableAt ℝ g x) : - DifferentiableAt ℝ (fun y : M => ⟪f y, g y⟫_ℝ) x := by - apply DifferentiableAt.inner <;> fun_prop + DifferentiableAt ℝ (fun y : M => ⟪f y, g y⟫_ℝ) x := + hf.inner ℝ hg @[fun_prop] lemma inner_apply_differentiable {d : ℕ} [NormedAddCommGroup M] [NormedSpace ℝ M] {f : M → Space d} {g : M → Space d} (hf : Differentiable ℝ f) (hg : Differentiable ℝ g) : - Differentiable ℝ (fun y : M => ⟪f y, g y⟫_ℝ) := by - apply Differentiable.inner <;> fun_prop + Differentiable ℝ (fun y : M => ⟪f y, g y⟫_ℝ) := + hf.inner ℝ hg @[fun_prop] lemma inner_contDiff {n : WithTop ℕ∞} {d : ℕ} : - ContDiff ℝ n (fun y : Space d => ⟪y, y⟫_ℝ) := by - apply ContDiff.inner <;> fun_prop + ContDiff ℝ n (fun y : Space d => ⟪y, y⟫_ℝ) := + contDiff_id.inner ℝ contDiff_id @[fun_prop] lemma inner_apply_contDiff {n : WithTop ℕ∞} {d : ℕ} [NormedAddCommGroup M] [NormedSpace ℝ M] {f : M → Space d} {g : M → Space d} (hf : ContDiff ℝ n f) (hg : ContDiff ℝ n g) : - ContDiff ℝ n (fun y : M => ⟪f y, g y⟫_ℝ) := by - apply ContDiff.inner <;> fun_prop + ContDiff ℝ n (fun y : M => ⟪f y, g y⟫_ℝ) := + hf.inner ℝ hg /-! #### A.10.2. Derivative of the inner product function @@ -426,8 +366,7 @@ lemma inner_apply_contDiff {n : WithTop ℕ∞} {d : ℕ} [NormedAddCommGroup M] lemma deriv_eq_inner_self (x : Space d) (i : Fin d) : deriv i (fun x => ⟪x, x⟫_ℝ) x = 2 * x i := by - convert deriv_norm_sq x i - exact real_inner_self_eq_norm_sq _ + simpa only [real_inner_self_eq_norm_sq] using deriv_norm_sq x i /-! @@ -438,22 +377,12 @@ lemma deriv_eq_inner_self (x : Space d) (i : Fin d) : @[simp] lemma deriv_inner_left {d} (x1 x2 : Space d) (i : Fin d) : deriv i (fun x => ⟪x, x2⟫_ℝ) x1 = x2 i := by - rw [deriv_eq_fderiv_basis] - rw [fderiv_inner_apply] - simp only [fderiv_fun_const, Pi.zero_apply, _root_.zero_apply, inner_zero_right, - fderiv_fun_id, ContinuousLinearMap.coe_id', id_eq, basis_inner, zero_add] - · fun_prop - · fun_prop + simp [deriv_eq, fderiv_inner_apply ℝ differentiableAt_fun_id (differentiableAt_const x2)] @[simp] lemma deriv_inner_right {d} (x1 x2 : Space d) (i : Fin d) : deriv i (fun x => ⟪x1, x⟫_ℝ) x2 = x1 i := by - rw [deriv_eq_fderiv_basis] - rw [fderiv_inner_apply] - simp only [fderiv_fun_id, ContinuousLinearMap.coe_id', id_eq, inner_basis, fderiv_fun_const, - Pi.ofNat_apply, _root_.zero_apply, inner_zero_left, add_zero] - · fun_prop - · fun_prop + simp [deriv_eq, fderiv_inner_apply ℝ (differentiableAt_const x1) differentiableAt_fun_id] /-! ### A.11. Differentiability of derivatives @@ -464,7 +393,7 @@ lemma deriv_differentiable {M} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} {f : Space d → M} (hf : ContDiff ℝ 2 f) (i : Fin d) : Differentiable ℝ (deriv i f) := by - suffices h1 : Differentiable ℝ (fun x => fderiv ℝ f x (basis i)) by exact h1 + unfold deriv fun_prop open ContDiff @@ -532,22 +461,8 @@ lemma schwartMap_fderiv_comm {d} ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis ν)) ((fderivCLM ℝ (Space d) ℝ) ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis μ)) ((fderivCLM ℝ (Space d) ℝ) η)))) x := by - have h1 := η.smooth - have h2 := h1 2 - change fderiv ℝ (fun x => fderiv ℝ η x (basis ν)) x (basis μ) = - fderiv ℝ (fun x => fderiv ℝ η x (basis μ)) x (basis ν) - rw [fderiv_clm_apply, fderiv_clm_apply] - simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, - ContinuousLinearMap.flip_apply] - rw [IsSymmSndFDerivAt.eq] - apply ContDiffAt.isSymmSndFDerivAt (n := 2) - · refine ContDiff.contDiffAt ?_ - exact h2 - · simp - · fun_prop - · exact differentiableAt_const (basis μ) - · fun_prop - · exact differentiableAt_const (basis ν) + change ∂[μ] (∂[ν] ⇑η) x = ∂[ν] (∂[μ] ⇑η) x + exact congrFun (deriv_commute _ (η.smooth 2)) x lemma distDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] (μ ν : Fin d) (f : (Space d) →d[ℝ] M) : @@ -555,7 +470,6 @@ lemma distDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] ext η simp [distDeriv, Distribution.fderivD] congr 1 - ext x - rw [schwartMap_fderiv_comm μ ν x η] + exact SchwartzMap.ext fun x => schwartMap_fderiv_comm μ ν x η end Space diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean b/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean index fb3eedc74..f9b44f4cf 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean @@ -132,8 +132,7 @@ lemma curl_smul (f : Space → EuclideanSpace ℝ (Fin 3)) (k : ℝ) @[to_fun] lemma curl_neg (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : Differentiable ℝ f) : ∇ ⨯ (-f) = -∇ ⨯ f := by - rw [← neg_one_smul ℝ, curl_smul, neg_one_smul] - · exact hf + rw [← neg_one_smul ℝ, curl_smul _ _ hf, neg_one_smul] @[to_fun] lemma curl_sub (f1 f2 : Space → EuclideanSpace ℝ (Fin 3)) @@ -156,12 +155,10 @@ lemma curl_linear_map (f : W → Space 3 → EuclideanSpace ℝ (Fin 3)) IsLinearMap ℝ (fun w => ∇ ⨯ (f w)) := by constructor · intro w w' - rw [hf'.map_add] - rw [curl_add] + rw [hf'.map_add, curl_add] repeat fun_prop · intros k w - rw [hf'.map_smul] - rw [curl_smul] + rw [hf'.map_smul, curl_smul] fun_prop /-! @@ -226,9 +223,8 @@ lemma curl_of_grad_eq_zero (f : Space → ℝ) (hf : ContDiff ℝ 2 f) : unfold curl grad ext x i simp only [Fin.isValue, Pi.zero_apply, PiLp.zero_apply] - rw [deriv_commute] + rw [deriv_commute _ hf] simp only [Fin.isValue, sub_self] - · exact hf /-! @@ -318,9 +314,8 @@ private lemma homotopyOperatorIntegrand_continuous_param {f : Space → Euclidea private lemma intervalIntegrable_homotopyOperatorIntegrand {f : Space → EuclideanSpace ℝ (Fin 3)} (hf : Differentiable ℝ f) (x : Space) : - IntervalIntegrable (homotopyOperatorIntegrand f x ·) volume (0 : ℝ) 1 := by - apply Continuous.intervalIntegrable - fun_prop + IntervalIntegrable (homotopyOperatorIntegrand f x ·) volume (0 : ℝ) 1 := + Continuous.intervalIntegrable (by fun_prop) 0 1 private lemma fderiv_homotopyOperatorIntegrand_eq_fderiv_crossProduct {f : Space → EuclideanSpace ℝ (Fin 3)} @@ -416,7 +411,6 @@ private lemma hasFDerivAt_intervalIntegral_homotopyOperatorIntegrand fun_prop) change HasFDerivAt (fun (x : Space) => ∫ (t : ℝ) in 0..1, F x t ∂(volume)) (∫ (t : ℝ) in 0..1, F' x₀ t ∂(volume)) x₀ - have hx :=hf.differentiable (by simp) apply intervalIntegral.hasFDerivAt_integral_of_dominated_of_fderiv_le (s := s x₀) (bound := fun t => ‖F' a.1 a.2‖) · exact Metric.closedBall_mem_nhds x₀ (by simp) @@ -541,37 +535,9 @@ lemma exists_curl_of_div_zero (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : C simp_all rw [curl_neg] fun_prop - have f_differentiable : Differentiable ℝ f := hf.differentiable (by simp) - have fderiv_f_t (x : Space) (t : ℝ) - (i : Fin 3) : (fderiv ℝ (fun t => (f (t • x)).ofLp i) t) 1 = fderiv ℝ f (t • x) x i := by - change (fderiv ℝ (EuclideanSpace.proj i ∘ f ∘ fun (t : ℝ) => t • x) t) 1 = _ - rw [fderiv_comp _ (by fun_prop) (by fun_prop), fderiv_comp _ (by fun_prop) (by fun_prop), - fderiv_fun_smul (by fun_prop) (by fun_prop)] - simp only [Function.comp_apply, ContinuousLinearMap.fderiv, fderiv_fun_const, Pi.zero_apply, - fderiv_fun_id, ContinuousLinearMap.coe_comp, _root_.add_apply, - FunLike.coe_smul, Pi.smul_apply, _root_.zero_apply, smul_zero, - ContinuousLinearMap.smulRight_apply, ContinuousLinearMap.coe_id', id_eq, one_smul, zero_add, - PiLp.proj_apply] - have hi (x : Space) (i : Fin 3) : ∫ (t : ℝ) in 0..1, (t * f (t • x) i * 2) - - t * (- fderiv ℝ f (t • x) (t • x)) i ∂(volume) = f x i := by - trans ∫ (t : ℝ) in 0..1, fderiv ℝ (fun t => t ^ 2 * f (t • x) i) t 1 ∂(volume) - · congr - funext t - rw [fderiv_fun_mul (by fun_prop) (by fun_prop)] - simp [fderiv_f_t] - ring - simp only [fderiv_eq_smul_deriv, smul_eq_mul, one_mul] - rw [intervalIntegral.integral_deriv_eq_sub (by fun_prop)] - simp only [one_pow, one_smul, one_mul, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, - zero_smul, zero_mul, sub_zero] - · apply Continuous.intervalIntegrable - fun_prop use fun x => ∫ (t : ℝ) in 0..1, homotopyOperatorIntegrand f x t ∂(volume) - apply And.intro - swap - · intro x - exact (hasFDerivAt_intervalIntegral_homotopyOperatorIntegrand (hf) _).differentiableAt - · exact eq_neg_curl_of_div_zero f hf hdiv + exact ⟨eq_neg_curl_of_div_zero f hf hdiv, + fun x => (hasFDerivAt_intervalIntegral_homotopyOperatorIntegrand hf x).differentiableAt⟩ TODO "Generalize the statement that a div-free field is a curl to time-dependent fields." @@ -680,10 +646,7 @@ lemma eq_grad_integral_of_curl_zero (f : Space → EuclideanSpace ℝ (Fin 3)) ( nth_rewrite 1 [eq_integral_grad h1] simp rw [contDiff_one_iff_hasFDerivAt] - use fun x => ((toDual ℝ Space) (basis.repr.symm (∇ g x))) - apply And.intro - · fun_prop - intro x + refine ⟨fun x => ((toDual ℝ Space) (basis.repr.symm (∇ g x))), by fun_prop, fun x => ?_⟩ exact hasGradientAt_iff_hasFDerivAt.mpr (DifferentiableAt.hasGradientAt_grad x (hg x)) TODO "Generalize the statement that a curl-free field is a gradient diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean b/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean index 38eb0f25c..08bb3d3ed 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean @@ -99,10 +99,8 @@ lemma grad_add (f1 f2 : Space d → ℝ) unfold grad ext x i simp only [Pi.add_apply] - rw [deriv_add] + rw [deriv_add f1 f2 hf1 hf2] rfl - exact hf1 - exact hf2 @[simp] lemma grad_fun_add_const (f : Space d → ℝ) (c : ℝ) : @@ -135,9 +133,8 @@ lemma grad_smul (f : Space d → ℝ) (k : ℝ) unfold grad ext x i simp only [Pi.smul_apply] - rw [deriv_const_smul] + rw [deriv_const_smul k hf] rfl - exact hf /-! @@ -162,19 +159,10 @@ lemma grad_neg (f : Space d → ℝ) : lemma grad_eq_sum {d} (f : Space d → ℝ) (x : Space d) : ∇ f x = ∑ i, ∂[i] f x • EuclideanSpace.single i 1 := by - ext i - simp [grad, deriv_eq, - WithLp.ofLp_sum] - trans ∑ x_1, (fderiv ℝ f x) (basis x_1) • (EuclideanSpace.single x_1 1).ofLp i; swap - · change _ = WithLp.linearEquiv 2 ℝ (V := Fin d → ℝ) (∑ x_1, (fderiv ℝ f x) (basis x_1) • - EuclideanSpace.single x_1 1) i - rw [map_sum, Finset.sum_apply] - rfl - rw [Finset.sum_eq_single i] - · simp [basis] - · intro j hj - simp [basis] - exact fun a a_1 => False.elim (a (id (Eq.symm a_1))) - · simp + ext j + simp only [grad, PiLp.toLp_apply, WithLp.ofLp_sum, WithLp.ofLp_smul, PiLp.ofLp_single, + Finset.sum_apply, Pi.smul_apply, Pi.single_apply, smul_eq_mul, mul_ite, mul_one, mul_zero, + Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] /-! @@ -184,11 +172,6 @@ lemma grad_eq_sum {d} (f : Space d → ℝ) (x : Space d) : lemma grad_apply {d} (f : Space d → ℝ) (x : Space d) (i : Fin d) : (∇ f x) i = ∂[i] f x := by - rw [grad_eq_sum] - change WithLp.linearEquiv 2 ℝ (Fin d → ℝ) (∑ x_1, (fderiv ℝ f x) (basis x_1) • - EuclideanSpace.single x_1 1) i = _ - rw [map_sum, Finset.sum_apply] - simp [Pi.single_apply] rfl /-! @@ -201,32 +184,23 @@ open InnerProductSpace lemma grad_inner_single {d} (f : Space d → ℝ) (x : Space d) (i : Fin d) : ⟪∇ f x, EuclideanSpace.single i 1⟫_ℝ = ∂[i] f x := by - simp only [EuclideanSpace.inner_single_right, conj_trivial, - one_mul] - exact rfl + simp [EuclideanSpace.inner_single_right, grad_apply] lemma grad_inner_eq {d} (f : Space d → ℝ) (x : Space d) (y : EuclideanSpace ℝ (Fin d)) : ⟪∇ f x, y⟫_ℝ = ∑ i, y i * ∂[i] f x:= by - have hy : y = ∑ i, y i • EuclideanSpace.basisFun (Fin d) ℝ i := by - conv_lhs => rw [← OrthonormalBasis.sum_repr (EuclideanSpace.basisFun (Fin d) ℝ) y] - dsimp [basis] - conv_lhs => rw [hy, inner_sum] - simp [inner_smul_right, grad_inner_single] + simp [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, grad_apply, mul_comm] lemma inner_grad_eq {d} (f : Space d → ℝ) (x : EuclideanSpace ℝ (Fin d)) (y : Space d) : - ⟪x, ∇ f y⟫_ℝ = ∑ i, x i * ∂[i] f y := by - rw [← grad_inner_eq] - exact real_inner_comm (∇ f y) x + ⟪x, ∇ f y⟫_ℝ = ∑ i, x i * ∂[i] f y := + (real_inner_comm (∇ f y) x).trans (grad_inner_eq f y x) lemma grad_inner_repr_eq {d} (f : Space d → ℝ) (x y : Space d) : ⟪∇ f x, (Space.basis).repr y⟫_ℝ = fderiv ℝ f x y := by - rw [grad_inner_eq f x ((Space.basis).repr y), Space.fderiv_eq_sum_deriv] - simp + simp [grad_inner_eq f x, fderiv_eq_sum_deriv] lemma repr_grad_inner_eq {d} (f : Space d → ℝ) (x y : Space d) : - ⟪(Space.basis).repr x, ∇ f y⟫_ℝ = fderiv ℝ f y x := by - rw [← grad_inner_repr_eq f y x] - exact real_inner_comm (∇ f y) ((Space.basis).repr x) + ⟪(Space.basis).repr x, ∇ f y⟫_ℝ = fderiv ℝ f y x := + (real_inner_comm (∇ f y) ((Space.basis).repr x)).trans (grad_inner_repr_eq f y x) /-! @@ -237,17 +211,9 @@ lemma repr_grad_inner_eq {d} (f : Space d → ℝ) (x y : Space d) : lemma grad_eq_gradient {d} (f : Space d → ℝ) : ∇ f = basis.repr ∘ gradient f := by funext x - have hx (y : EuclideanSpace ℝ (Fin d)) : ⟪(Space.basis).repr (gradient f x), y⟫_ℝ = - ⟪∇ f x, y⟫_ℝ := by - rw [gradient, basis_repr_inner_eq, toDual_symm_apply] - simp [grad_inner_eq f x, fderiv_eq_sum_deriv] - have h1 : ∀ y, ⟪(Space.basis).repr (gradient f x) - ∇ f x, y⟫_ℝ = 0 := by - intro y - rw [inner_sub_left, hx y] - simp - have h2 := h1 (basis.repr (gradient f x) - ∇ f x) - rw [inner_self_eq_zero, sub_eq_zero] at h2 - simp [h2] + refine ext_inner_right (𝕜 := ℝ) fun y => ?_ + rw [Function.comp_apply, gradient, basis_repr_inner_eq, toDual_symm_apply] + simp [grad_inner_eq f x, fderiv_eq_sum_deriv] lemma gradient_eq_grad {d} (f : Space d → ℝ) : gradient f = basis.repr.symm ∘ ∇ f := by @@ -272,10 +238,7 @@ lemma euclid_gradient_eq_sum {d} (f : EuclideanSpace ℝ (Fin d) → ℝ) (x : E conv_lhs => rw [← OrthonormalBasis.sum_repr (EuclideanSpace.basisFun (Fin d) ℝ) y] simp conv_lhs => rw [hy] - simp [sum_inner, inner_smul_left, EuclideanSpace.inner_single_left] - congr - funext i - ring + simp [sum_inner, inner_smul_left, EuclideanSpace.inner_single_left, mul_comm] lemma _root_.DifferentiableAt.hasGradientAt_grad {d} {f : Space d → ℝ} (x : Space d) (hf : DifferentiableAt ℝ f x) : @@ -303,9 +266,7 @@ lemma grad_inner_space_unit_vector {d} (x : Space d) (f : Space d → ℝ) (hd : simp _ = (fderiv ℝ f x) (_root_.deriv (fun r => r • ‖x‖⁻¹ • x) ‖x‖) := by have hx : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr hx - rw [smul_smul] - field_simp - simp + rw [smul_smul, mul_inv_cancel₀ hx, one_smul] rw [grad_inner_eq f x (‖x‖⁻¹ • basis.repr x)] rw [deriv_smul_const (by fun_prop)] simp only [deriv_id'', one_smul, map_smul, fderiv_eq_sum_deriv, smul_eq_mul, Finset.mul_sum, @@ -389,11 +350,8 @@ lemma eq_integral_grad {f : Space → ℝ} (hf : ContDiff ℝ 1 f) : lemma grad_norm_sq (x : Space d) : ∇ (fun x => ‖x‖ ^ 2) x = (2 : ℝ) • basis.repr x := by ext i - rw [grad_eq_sum] - change WithLp.linearEquiv 2 ℝ (Fin d → ℝ) (∑ x_1, (fderiv ℝ (fun x => ‖x‖ ^ 2) x) (basis x_1) • - EuclideanSpace.single x_1 1) i = _ - rw [map_sum, Finset.sum_apply] - simp [Pi.single_apply] + rw [grad_apply, deriv_norm_sq] + simp /-! @@ -405,10 +363,7 @@ lemma grad_norm_sq (x : Space d) : lemma grad_inner {d : ℕ} : ∇ (fun y : Space d => ⟪y, y⟫_ℝ) = fun z => (2 : ℝ) • basis.repr z := by ext z i - simp [Space.grad] - rw [deriv] - simp only [fderiv_norm_sq_apply, FunLike.coe_smul, coe_innerSL_apply, Pi.smul_apply, - nsmul_eq_mul, Nat.cast_ofNat, mul_eq_mul_left_iff, OfNat.ofNat_ne_zero, or_false] + rw [grad_apply, deriv_eq_inner_self] simp lemma grad_inner_left {d : ℕ} (x : Space d) : @@ -418,10 +373,8 @@ lemma grad_inner_left {d : ℕ} (x : Space d) : lemma grad_inner_right {d : ℕ} (x : Space d) : ∇ (fun y : Space d => ⟪x, y⟫_ℝ) = fun _ => basis.repr x := by - rw [← grad_inner_left x] - congr - funext y - exact real_inner_comm y x + simp_rw [← real_inner_comm x] + exact grad_inner_left x /-! @@ -467,8 +420,7 @@ lemma integrable_isDistBounded_inner_grad_schwartzMap_spherical {d : ℕ} change Integrable ((fun x => ⟪f x, Space.grad η x⟫_ℝ) ∘ Subtype.val) (.comap (Subtype.val (p := fun x => x ∈ ({0}ᶜ : Set _))) volume) rw [← MeasureTheory.integrableOn_iff_comap_subtypeVal] - apply Integrable.integrableOn - exact integrable_isDistBounded_inner_grad_schwartzMap hf η + exact (integrable_isDistBounded_inner_grad_schwartzMap hf η).integrableOn simp have he := (MeasureTheory.Measure.measurePreserving_homeomorphUnitSphereProd (volume (α := Space d))) @@ -554,8 +506,8 @@ lemma distGrad_eq_sum_basis {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d ∇ᵈ f η = ∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • EuclideanSpace.single i 1 := by - have h1 (y : EuclideanSpace ℝ (Fin d)) : - ⟪∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • + refine ext_inner_right (𝕜 := ℝ) fun y => ?_ + have h1 : ⟪∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • EuclideanSpace.single i 1, y⟫_ℝ = fderivD ℝ f η (basis.repr.symm y) := by have hy : y = ∑ i, y i • EuclideanSpace.single i 1 := by @@ -564,21 +516,7 @@ lemma distGrad_eq_sum_basis {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d rw [hy] simp [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, map_sum, map_smul, smul_eq_mul, Pi.single_apply, fderivD_apply] - have hx (y : EuclideanSpace ℝ (Fin d)) : ⟪∇ᵈ f η, y⟫_ℝ = - ⟪∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • - EuclideanSpace.single i 1, y⟫_ℝ := by - rw [distGrad_inner_eq, h1] - have h1 : ∀ y, ⟪∇ᵈ f η - - (∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • - EuclideanSpace.single i 1), y⟫_ℝ = 0 := by - intro y - rw [inner_sub_left, hx y] - simp - have h2 := h1 (∇ᵈ f η - - (∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • - EuclideanSpace.single i 1)) - rw [inner_self_eq_zero, sub_eq_zero] at h2 - rw [h2] + rw [distGrad_inner_eq, h1] /-! @@ -617,8 +555,7 @@ lemma distGrad_apply {d} (f : (Space d) →d[ℝ] ℝ) (ε : 𝓢(Space d, ℝ)) lemma distGrad_const {d} (c : ℝ) : ∇ᵈ (Distribution.const ℝ (Space d) c) = 0 := by ext ε i - simp only [distGrad_apply, distDeriv_apply] - simp [Distribution.fderivD_const] + simp [distGrad_apply, distDeriv_apply, Distribution.fderivD_const] /-! diff --git a/Physlib/SpaceAndTime/Space/DistConst.lean b/Physlib/SpaceAndTime/Space/DistConst.lean index 7d8259859..e169eda71 100644 --- a/Physlib/SpaceAndTime/Space/DistConst.lean +++ b/Physlib/SpaceAndTime/Space/DistConst.lean @@ -58,25 +58,21 @@ noncomputable def distConst {M } [NormedAddCommGroup M] [NormedSpace ℝ M] (d : lemma distDeriv_distConst {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] (μ : Fin d) (m : M) : distDeriv μ (distConst d m) = 0 := by - ext η simp [distDeriv, distConst] @[simp] lemma distGrad_distConst {d} (m : ℝ) : distGrad (distConst d m) = 0 := by - ext η - simp [distGrad, distConst] + simp [distConst] @[simp] lemma distDiv_distConst {d} (m : EuclideanSpace ℝ (Fin d)) : distDiv (distConst d m) = 0 := by - ext η simp [distDiv, distConst] @[simp] lemma distCurl_distConst (m : EuclideanSpace ℝ (Fin 3)) : distCurl (distConst 3 m) = 0 := by - ext η simp [distCurl, distConst] end Space diff --git a/Physlib/SpaceAndTime/Space/IsDistBounded.lean b/Physlib/SpaceAndTime/Space/IsDistBounded.lean index ac8f3095a..d1cae0576 100644 --- a/Physlib/SpaceAndTime/Space/IsDistBounded.lean +++ b/Physlib/SpaceAndTime/Space/IsDistBounded.lean @@ -127,20 +127,14 @@ lemma aeStronglyMeasurable_fderiv_schwartzMap_smul {d : ℕ} {f : Space d → F} @[fun_prop] lemma aeStronglyMeasurable_inv_pow {d r : ℕ} {f : Space d → F} (hf : IsDistBounded f) : - AEStronglyMeasurable (fun x => ‖((1 + ‖x‖) ^ r)⁻¹‖ • f x) := by - apply AEStronglyMeasurable.smul - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · fun_prop + AEStronglyMeasurable (fun x => ‖((1 + ‖x‖) ^ r)⁻¹‖ • f x) := + AEStronglyMeasurable.smul (AEMeasurable.aestronglyMeasurable (by fun_prop)) (by fun_prop) @[fun_prop] lemma aeStronglyMeasurable_time_schwartzMap_smul {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) (η : 𝓢(Time × Space d, ℝ)) : - AEStronglyMeasurable (fun x => η x • f x.2) := by - apply AEStronglyMeasurable.smul - · fun_prop - · apply MeasureTheory.AEStronglyMeasurable.comp_snd - fun_prop + AEStronglyMeasurable (fun x => η x • f x.2) := + AEStronglyMeasurable.smul (by fun_prop) (AEStronglyMeasurable.comp_snd (by fun_prop)) /-! @@ -160,20 +154,13 @@ lemma integrable_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) · fun_prop · filter_upwards with x rw [norm_smul] - apply le_trans (mul_le_mul_of_nonneg_left (bound x) (norm_nonneg (η x))) - apply le_of_eq + refine (mul_le_mul_of_nonneg_left (bound x) (norm_nonneg (η x))).trans (le_of_eq ?_) simp only [Real.norm_eq_abs] rw [Finset.abs_sum_of_nonneg (fun i _ => mul_nonneg (c_nonneg i) (by positivity)), Finset.mul_sum] ring_nf - · apply MeasureTheory.integrable_finsetSum - intro i _ - apply Integrable.const_mul - specialize h2 (p i) (p_bound i) (g i) η - rw [← MeasureTheory.integrable_norm_iff] at h2 - simpa using h2 - apply AEMeasurable.aestronglyMeasurable - fun_prop + · refine MeasureTheory.integrable_finsetSum _ fun i _ => Integrable.const_mul ?_ _ + simpa using (h2 (p i) (p_bound i) (g i) η).norm /- Reducing the problem to `Integrable (fun x : Space d => η x * ‖x‖ ^ p)` -/ suffices h0 : ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (η : 𝓢(Space d, ℝ)), Integrable (fun x : Space d => η x * ‖x‖ ^ p) volume by @@ -194,28 +181,22 @@ lemma integrable_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) positivity /- Proving `Integrable (fun x : Space d => η x * ‖x + c‖ ^ p)` -/ intro p hp η - have h1 : AEStronglyMeasurable (fun (x : Space d) => ‖x‖ ^ p) volume := - AEMeasurable.aestronglyMeasurable <| by fun_prop - rw [← MeasureTheory.integrable_norm_iff (by fun_prop)] + rw [← MeasureTheory.integrable_norm_iff (AEMeasurable.aestronglyMeasurable (by fun_prop))] simp only [norm_mul, norm_zpow, norm_norm] match d with | 0 => simp only [Real.norm_eq_abs, Integrable.of_finite] | d + 1 => by_cases hp' : p = 0 · subst hp' - simp only [zpow_zero, mul_one] - apply Integrable.norm - exact η.integrable + simpa using η.integrable.norm suffices h1 : Integrable (fun x => ‖η x‖ * ‖x‖ ^ (p + d)) (radialAngularMeasure (d := (d + 1))) by rw [integrable_radialAngularMeasure_iff] at h1 convert h1 using 1 funext x - have hx : 0 ≤ ‖x‖ := norm_nonneg x - generalize ‖x‖ = r at * + generalize ‖x‖ = r simp only [Real.norm_eq_abs, add_tsub_cancel_right, one_div, smul_eq_mul] - trans |η x| * ((r ^ d)⁻¹ *r ^ (p + d)); swap - · ring - congr + rw [mul_left_comm] + congr 1 by_cases hr : r = 0 · subst hr simp [zero_pow_eq, zero_zpow_eq, hp'] @@ -226,12 +207,7 @@ lemma integrable_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) convert integrable_pow_mul_iteratedFDeriv radialAngularMeasure η (p + d).toNat 0 using 1 funext x simp only [Real.norm_eq_abs, norm_iteratedFDeriv_zero] - rw [mul_comm] - congr 1 - rw [← zpow_natCast] - congr - refine Int.eq_natCast_toNat.mpr ?_ - omega + rw [mul_comm, ← zpow_natCast, Int.toNat_of_nonneg (by omega)] @[fun_prop] lemma integrable_space_mul {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) @@ -242,14 +218,14 @@ lemma integrable_space_mul {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f @[fun_prop] lemma integrable_space_fderiv {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) (y : Space d) : - Integrable (fun x : Space d => fderiv ℝ η x y • f x) volume := by - exact hf.integrable_space (LineDeriv.lineDerivOpCLM ℝ _ y η) + Integrable (fun x : Space d => fderiv ℝ η x y • f x) volume := + hf.integrable_space (LineDeriv.lineDerivOpCLM ℝ _ y η) @[fun_prop] lemma integrable_space_fderiv_mul {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) (y : Space d) : - Integrable (fun x : Space d => fderiv ℝ η x y * f x) volume := by - exact hf.integrable_space (LineDeriv.lineDerivOpCLM ℝ _ y η) + Integrable (fun x : Space d => fderiv ℝ η x y * f x) volume := + hf.integrable_space (LineDeriv.lineDerivOpCLM ℝ _ y η) /-! @@ -280,12 +256,10 @@ instance {D1 : Type} [NormedAddCommGroup D1] [MeasurableSpace D1] rw [abs_of_nonneg (by positivity)] simp only [Real.rpow_neg_natCast, zpow_neg, zpow_natCast] apply mul_le_mul _ _ (by positivity) (by positivity) - · refine inv_anti₀ (by positivity) (pow_le_pow_left₀ (by positivity) ?_ rt1) - rcases x - simp - · refine inv_anti₀ (by positivity) (pow_le_pow_left₀ (by positivity) ?_ rt2) - rcases x - simp + · exact inv_anti₀ (by positivity) + (pow_le_pow_left₀ (by positivity) (by simpa using norm_fst_le x) rt1) + · exact inv_anti₀ (by positivity) + (pow_le_pow_left₀ (by positivity) (by simpa using norm_snd_le x) rt2) @[fun_prop] lemma integrable_time_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) @@ -299,20 +273,13 @@ lemma integrable_time_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) · fun_prop · filter_upwards with x rw [norm_smul] - apply le_trans (mul_le_mul_of_nonneg_left (bound x.2) (norm_nonneg (η x))) - apply le_of_eq + refine (mul_le_mul_of_nonneg_left (bound x.2) (norm_nonneg (η x))).trans (le_of_eq ?_) simp only [Real.norm_eq_abs] rw [Finset.abs_sum_of_nonneg (fun i _ => mul_nonneg (c_nonneg i) (by positivity)), Finset.mul_sum] ring_nf - · apply MeasureTheory.integrable_finsetSum - intro i _ - apply Integrable.const_mul - specialize h2 (p i) (p_bound i) (g i) η - rw [← MeasureTheory.integrable_norm_iff] at h2 - simpa using h2 - apply AEMeasurable.aestronglyMeasurable - fun_prop + · refine MeasureTheory.integrable_finsetSum _ fun i _ => Integrable.const_mul ?_ _ + simpa using (h2 (p i) (p_bound i) (g i) η).norm /- Reducing the problem to `Integrable (fun x : Space d => η x * ‖x‖ ^ p)` -/ suffices h0 : ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (η : 𝓢(Time × Space d, ℝ)), Integrable (fun x : Time × Space d => η x * ‖x.2‖ ^ p) volume by @@ -380,22 +347,12 @@ lemma integrable_time_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) · simp · fun_prop apply Integrable.mono' (integrable_pow_mul_iteratedFDeriv _ η (p + (d - 1 : ℕ)).toNat 0) - · apply AEMeasurable.aestronglyMeasurable - fun_prop + (AEMeasurable.aestronglyMeasurable (by fun_prop)) filter_upwards with x simp only [Real.norm_eq_abs, norm_iteratedFDeriv_zero] - rw [mul_comm, ← zpow_natCast, abs_of_nonneg (by positivity)] - apply mul_le_mul _ (by rfl) (by positivity) (by positivity) - rw [zpow_natCast] - trans ‖x.2‖ ^ ((p + (d - 1 : ℕ)).toNat : ℤ) - · apply le_of_eq - congr - refine Int.eq_natCast_toNat.mpr (by omega) - rw [zpow_natCast] - ring_nf - apply pow_le_pow_left₀ (by positivity) _ (p + (d - 1 : ℕ)).toNat - rcases x - simp + rw [abs_of_nonneg (by positivity), mul_comm, ← zpow_natCast, Int.toNat_of_nonneg (by omega)] + exact mul_le_mul_of_nonneg_right + (zpow_le_zpow_left₀ (by omega) (norm_nonneg _) (norm_snd_le x)) (abs_nonneg _) /-! @@ -414,29 +371,23 @@ lemma integrable_mul_inv_pow {d : ℕ} | 0 => simp at bound; simp [bound] | n + 1 => let pMax := Finset.max' (Finset.image p Finset.univ) (by simp) - have pMax_max (i : Fin n.succ) : p i ≤ pMax := by - simp [pMax] - apply Finset.le_max' - simp + have pMax_max (i : Fin n.succ) : p i ≤ pMax := + Finset.le_max' _ _ (Finset.mem_image_of_mem p (Finset.mem_univ i)) obtain ⟨r, hr⟩ := h0 pMax use r apply Integrable.mono (g := fun x => ∑ i, (c i * (‖((1 + ‖x‖) ^ r)⁻¹‖ * ‖x + g i‖ ^ p i))) _ · fun_prop · filter_upwards with x rw [norm_smul] - apply le_trans (mul_le_mul_of_nonneg_left (bound x) (by positivity)) - apply le_of_eq + refine (mul_le_mul_of_nonneg_left (bound x) (by positivity)).trans (le_of_eq ?_) simp only [norm_inv, norm_pow, Real.norm_eq_abs, abs_abs] rw [Finset.abs_sum_of_nonneg (fun i _ => mul_nonneg (c_nonneg i) (by positivity)), Finset.mul_sum] ring_nf - · apply MeasureTheory.integrable_finsetSum - intro i _ - apply Integrable.const_mul - apply (hr (p i) (p_bound i) (g i) (pMax_max i)).mono - · fun_prop - · filter_upwards with x - simp + · refine MeasureTheory.integrable_finsetSum _ fun i _ => Integrable.const_mul ?_ _ + refine (hr (p i) (p_bound i) (g i) (pMax_max i)).mono (by fun_prop) ?_ + filter_upwards with x + simp match d with | 0 => simp | d + 1 => @@ -445,19 +396,18 @@ lemma integrable_mul_inv_pow {d : ℕ} intro pMax use (pMax + d).toNat + (radialAngularMeasure (d := d + 1)).integrablePower intro p hp c p_le - apply (h0 (p + d).toNat c).mono - · fun_prop - · filter_upwards with x - simp only [norm_inv, norm_pow, Real.norm_eq_abs, norm_mul, abs_abs, norm_zpow, - Int.ofNat_toNat] - rw [mul_comm] - refine mul_le_mul ?_ ?_ (by positivity) (by positivity) - · rw [max_eq_left (by omega)] + refine (h0 (p + d).toNat c).mono (by fun_prop) ?_ + filter_upwards with x + simp only [norm_inv, norm_pow, Real.norm_eq_abs, norm_mul, abs_abs, norm_zpow, + Int.ofNat_toNat] + rw [mul_comm] + refine mul_le_mul ?_ ?_ (by positivity) (by positivity) + · rw [max_eq_left (by omega)] + simp + · refine inv_pow_le_inv_pow_of_le ?_ ?_ + · rw [abs_of_nonneg (by positivity)] simp - · refine inv_pow_le_inv_pow_of_le ?_ ?_ - · rw [abs_of_nonneg (by positivity)] - simp - · simp_all + · simp_all let m := (radialAngularMeasure (d := (d + 1))).integrablePower suffices h0 : ∀ (q : ℕ) (c : Space (d + 1)), Integrable (fun x => ‖x‖ ^ (q - d : ℤ) * ‖((1 + ‖x - c‖) ^ (q + m))⁻¹‖) volume by @@ -470,12 +420,8 @@ lemma integrable_mul_inv_pow {d : ℕ} intro q v specialize h0 q v rw [integrable_radialAngularMeasure_iff] at h0 - apply Integrable.congr h0 - rw [Filter.eventuallyEq_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx + refine h0.congr (Filter.eventuallyEq_of_mem (compl_mem_ae_iff.mpr (measure_singleton 0)) + fun x hx => ?_) simp [← mul_assoc] left rw [zpow_sub₀ (by simpa using hx), zpow_natCast, zpow_natCast] @@ -485,54 +431,20 @@ lemma integrable_mul_inv_pow {d : ℕ} ‖((1 + ‖x - v‖) ^ (q + m))⁻¹‖ = ((1 + ‖x - v‖) ^ (q + m))⁻¹ := by simp only [norm_inv, norm_pow, Real.norm_eq_abs, inv_inj] rw [abs_of_nonneg (by positivity)] - apply integrable_of_le_of_pow_mul_le (C₁ := 1) (C₂ :=2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + 1)) - · simp - intro x - refine inv_le_one_of_one_le₀ ?_ - rw [abs_of_nonneg (by positivity)] - refine one_le_pow₀ ?_ - simp + apply integrable_of_le_of_pow_mul_le (C₁ := 1) (C₂ := (1 + ‖v‖) ^ (q + m)) + · intro x + rw [hr1] + exact inv_le_one_of_one_le₀ (one_le_pow₀ (by simp)) · intro x rw [hr1] refine mul_inv_le_of_le_mul₀ ?_ (by positivity) ?_ · positivity - change ‖x‖^ (q + m) ≤ _ - by_cases hzero : m = 0 ∧ q = 0 - · rcases hzero with ⟨hm, hq⟩ - generalize hm : m = m' at * - subst hm hq - rw [pow_zero, pow_zero] - simp - trans (‖v‖ + ‖x - v‖) ^ (q + m) - · rw [pow_le_pow_iff_left₀] - · apply norm_le_norm_add_norm_sub' - · positivity - · positivity - simp only [ne_eq, Nat.add_eq_zero_iff, not_and] - intro hq - omega - apply (add_pow_le _ _ _).trans - trans 2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + ‖x - v‖ ^ (q + m)) + (2 ^ (q + m - 1) - + 2 ^ (q + m - 1) * ‖v‖ ^ (q + m) * ‖x - v‖ ^ (q + m)) - · simp - positivity - trans (2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + 1)) * (1 + ‖x - v‖ ^ (q + m)) - · apply le_of_eq - ring - refine mul_le_mul_of_nonneg (by rfl) ?_ ?_ ?_ - · trans 1 ^ (q + m) + ‖x - v‖ ^ (q + m) - · simp - apply pow_add_pow_le - · simp - · positivity - · simp - omega - · positivity - · positivity - · positivity - · positivity - · refine Measurable.aestronglyMeasurable ?_ - fun_prop + change ‖x‖ ^ (q + m) ≤ _ + calc ‖x‖ ^ (q + m) ≤ ((1 + ‖v‖) * (1 + ‖x - v‖)) ^ (q + m) := by + refine pow_le_pow_left₀ (norm_nonneg x) ?_ _ + nlinarith [norm_le_norm_add_norm_sub' x v, norm_nonneg (x - v), norm_nonneg v] + _ = (1 + ‖v‖) ^ (q + m) * (1 + ‖x - v‖) ^ (q + m) := mul_pow _ _ _ + · exact Measurable.aestronglyMeasurable (by fun_prop) /-! @@ -551,13 +463,8 @@ lemma integral_mul_schwartzMap_bounded {d : ℕ} {f : Space d → F} (hf : IsDis refine integral_mono_of_nonneg ?_ ?_ ?_ · filter_upwards with x positivity - · apply Integrable.mul_const - apply Integrable.const_mul - apply Integrable.congr' hr - · apply AEStronglyMeasurable.mul - · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop + · refine (Integrable.congr' hr (AEStronglyMeasurable.mul (by fun_prop) + (AEMeasurable.aestronglyMeasurable (by fun_prop))) ?_).const_mul _ |>.mul_const _ filter_upwards with x simp [norm_smul, mul_comm] · filter_upwards with x @@ -570,7 +477,7 @@ lemma integral_mul_schwartzMap_bounded {d : ℕ} {f : Space d → F} (hf : IsDis apply mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) have h0 := one_add_le_sup_seminorm_apply (𝕜 := ℝ) (m := (r, 0)) (k := r) (n := 0) le_rfl le_rfl η x - rw [Lean.Grind.Field.IsOrdered.le_mul_inv_iff_mul_le _ _ (by positivity)] + rw [le_mul_inv_iff₀ (by positivity)] convert! h0 using 1 simp only [norm_iteratedFDeriv_zero, Real.norm_eq_abs] ring_nf @@ -589,11 +496,8 @@ variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [Nor [NormedAddCommGroup F'] [NormedSpace ℝ F'] @[fun_prop] -lemma zero {d} : IsDistBounded (0 : Space d → F) := by - apply And.intro - · fun_prop - use 1, fun _ => 0, fun _ => 0, fun _ => 0 - simp +lemma zero {d} : IsDistBounded (0 : Space d → F) := + ⟨by fun_prop, 1, fun _ => 0, fun _ => 0, fun _ => 0, by simp⟩ /-! @@ -603,35 +507,20 @@ lemma zero {d} : IsDistBounded (0 : Space d → F) := by @[fun_prop] lemma add {d : ℕ} {f g : Space d → F} (hf : IsDistBounded f) (hg : IsDistBounded g) : IsDistBounded (f + g) := by - apply And.intro - · fun_prop rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ rcases hg with ⟨hae2, ⟨n2, c2, g2, p2, c2_nonneg, p2_bound, bound2⟩⟩ - refine ⟨n1 + n2, Fin.append c1 c2, Fin.append g1 g2, Fin.append p1 p2, ?_, ?_, ?_⟩ + refine ⟨by fun_prop, n1 + n2, Fin.append c1 c2, Fin.append g1 g2, Fin.append p1 p2, ?_, ?_, ?_⟩ · intro i - obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i - match i with - | .inl i => - simp only [finSumFinEquiv_apply_left, Fin.append_left, ge_iff_le] - exact c1_nonneg i - | .inr i => - simp only [finSumFinEquiv_apply_right, Fin.append_right, ge_iff_le] - exact c2_nonneg i + induction i using Fin.addCases with + | left i => simpa using c1_nonneg i + | right i => simpa using c2_nonneg i · intro i - obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i - match i with - | .inl i => - simp only [finSumFinEquiv_apply_left, Fin.append_left, ge_iff_le] - exact p1_bound i - | .inr i => - simp only [finSumFinEquiv_apply_right, Fin.append_right, ge_iff_le] - exact p2_bound i + induction i using Fin.addCases with + | left i => simpa using p1_bound i + | right i => simpa using p2_bound i · intro x - apply (norm_add_le _ _).trans - apply (add_le_add (bound1 x) (bound2 x)).trans - apply le_of_eq - rw [← finSumFinEquiv.sum_comp] - simp + refine ((norm_add_le _ _).trans (add_le_add (bound1 x) (bound2 x))).trans_eq ?_ + simp [Fin.sum_univ_add] @[fun_prop] lemma fun_add {d : ℕ} {f g : Space d → F} @@ -647,20 +536,15 @@ lemma fun_add {d : ℕ} {f g : Space d → F} lemma sum {ι : Type*} {s : Finset ι} {d : ℕ} {f : ι → Space d → F} (hf : ∀ i ∈ s, IsDistBounded (f i)) : IsDistBounded (∑ i ∈ s, f i) := by classical - induction' s using Finset.induction with i s hi ih - · simp - fun_prop - rw [Finset.sum_insert] - apply IsDistBounded.add - · exact hf i (s.mem_insert_self i) - · exact ih (fun j hj => hf j (s.mem_insert_of_mem hj)) - exact hi + induction s using Finset.induction with + | empty => simpa using zero + | insert i s hi ih => + rw [Finset.sum_insert hi] + exact (hf i (s.mem_insert_self i)).add (ih fun j hj => hf j (s.mem_insert_of_mem hj)) lemma sum_fun {ι : Type*} {s : Finset ι} {d : ℕ} {f : ι → Space d → F} - (hf : ∀ i ∈ s, IsDistBounded (f i)) : IsDistBounded (fun x => ∑ i ∈ s, f i x) := by - convert sum hf using 1 - funext x - simp + (hf : ∀ i ∈ s, IsDistBounded (f i)) : IsDistBounded (fun x => ∑ i ∈ s, f i x) := + Finset.sum_fn s f ▸ sum hf /-! @@ -672,27 +556,15 @@ lemma sum_fun {ι : Type*} {s : Finset ι} {d : ℕ} {f : ι → Space d → F} lemma const_smul {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (c • f) := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · fun_prop - refine ⟨n1, ‖c‖ • c1, g1, p1, ?_, p1_bound, ?_⟩ - · intro i - simp only [Real.norm_eq_abs, Pi.smul_apply, smul_eq_mul] - have hi := c1_nonneg i - positivity - · intro x - simp [norm_smul] - conv_rhs => enter [2, x]; rw [mul_assoc] - rw [← Finset.mul_sum] - refine mul_le_mul (by rfl) (bound1 x) ?_ ?_ - · exact norm_nonneg (f x) - · exact abs_nonneg c + refine ⟨by fun_prop, n1, ‖c‖ • c1, g1, p1, + fun i => mul_nonneg (norm_nonneg c) (c1_nonneg i), p1_bound, fun x => ?_⟩ + simp only [Pi.smul_apply, norm_smul, smul_eq_mul, mul_assoc, ← Finset.mul_sum] + exact mul_le_mul_of_nonneg_left (bound1 x) (norm_nonneg c) @[fun_prop] lemma neg {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} (hf : IsDistBounded f) : IsDistBounded (fun x => - f x) := by - convert hf.const_smul (-1) using 1 - funext x - simp + simpa [Pi.neg_def] using hf.const_smul (-1) @[fun_prop] lemma const_fun_smul {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} @@ -707,9 +579,7 @@ lemma const_mul_fun {d : ℕ} lemma mul_const_fun {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (fun x => f x * c) := by - convert hf.const_smul c using 2 - simp only [Pi.smul_apply, smul_eq_mul] - ring + simpa [Pi.smul_def, mul_comm] using hf.const_smul c /-! @@ -722,28 +592,13 @@ lemma pi_comp {d n : ℕ} {f : Space d → EuclideanSpace ℝ (Fin n)} (hf : IsDistBounded f) (j : Fin n) : IsDistBounded (fun x => f x j) := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · fun_prop - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - apply le_trans ?_ (bound1 x) - simp only [Real.norm_eq_abs] - rw [@PiLp.norm_eq_of_L2] - refine Real.abs_le_sqrt ?_ - trans ∑ i ∈ {j}, ‖(f x) i‖ ^ 2 - · simp - apply Finset.sum_le_univ_sum_of_nonneg - intro y - exact sq_nonneg ‖f x y‖ + exact ⟨by fun_prop, n1, c1, g1, p1, c1_nonneg, p1_bound, + fun x => (PiLp.norm_apply_le (f x) j).trans (bound1 x)⟩ lemma vector_component {d n : ℕ} {f : Space d → Lorentz.Vector n} (hf : IsDistBounded f) (j : Fin 1 ⊕ Fin n) : IsDistBounded (fun x => f x j) := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · fun_prop - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - apply le_trans ?_ (bound1 x) + refine ⟨by fun_prop, n1, c1, g1, p1, c1_nonneg, p1_bound, fun x => le_trans ?_ (bound1 x)⟩ simp [Real.norm_eq_abs] /-! @@ -756,20 +611,10 @@ lemma comp_add_right {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) (c : Space d) : IsDistBounded (fun x => f (x + c)) := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · simp - apply AEStronglyMeasurable.comp_measurable - · rw [Measure.IsAddRightInvariant.map_add_right_eq_self] - fun_prop - · fun_prop - refine ⟨n1, c1, fun i => g1 i + c, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - apply (bound1 (x + c)).trans - apply le_of_eq - congr 1 - funext x - congr 3 - module + refine ⟨hae1.comp_measurePreserving (measurePreserving_add_right volume c), + n1, c1, fun i => g1 i + c, p1, c1_nonneg, p1_bound, fun x => ?_⟩ + refine (bound1 (x + c)).trans_eq (Finset.sum_congr rfl fun i _ => ?_) + rw [add_right_comm, add_assoc] lemma comp_sub_right {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) (c : Space d) : @@ -787,12 +632,7 @@ lemma congr {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) (hae : AEStronglyMeasurable g) (hfg : ∀ x, ‖g x‖ = ‖f x‖) : IsDistBounded g := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · exact hae - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - rw [hfg x] - exact bound1 x + exact ⟨hae, n1, c1, g1, p1, c1_nonneg, p1_bound, fun x => (hfg x).le.trans (bound1 x)⟩ /-! @@ -806,11 +646,7 @@ lemma mono {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) (hae : AEStronglyMeasurable g) (hfg : ∀ x, ‖g x‖ ≤ ‖f x‖) : IsDistBounded g := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · exact hae - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - exact (hfg x).trans (bound1 x) + exact ⟨hae, n1, c1, g1, p1, c1_nonneg, p1_bound, fun x => (hfg x).trans (bound1 x)⟩ /-! @@ -825,21 +661,11 @@ lemma inner_left {d n : ℕ} (hf : IsDistBounded f) (y : EuclideanSpace ℝ (Fin n)) : IsDistBounded (fun x => ⟪f x, y⟫_ℝ) := by rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ - apply And.intro - · fun_prop - refine ⟨n1, fun i => ‖y‖ * c1 i, g1, p1, ?_, p1_bound, ?_⟩ - · intro i - simp only - have hi := c1_nonneg i - positivity - · intro x - apply (norm_inner_le_norm (f x) y).trans - rw [mul_comm] - conv_rhs => enter [2, i]; rw [mul_assoc] - rw [← Finset.mul_sum] - refine mul_le_mul (by rfl) (bound1 x) ?_ ?_ - · exact norm_nonneg (f x) - · exact norm_nonneg y + refine ⟨by fun_prop, n1, fun i => ‖y‖ * c1 i, g1, p1, + fun i => mul_nonneg (norm_nonneg y) (c1_nonneg i), p1_bound, fun x => ?_⟩ + simp only [mul_assoc, ← Finset.mul_sum] + exact ((norm_inner_le_norm (f x) y).trans_eq (mul_comm _ _)).trans + (mul_le_mul_of_nonneg_left (bound1 x) (norm_nonneg y)) /-! @@ -848,12 +674,8 @@ lemma inner_left {d n : ℕ} @[fun_prop] lemma smul_const {d : ℕ} [NormedSpace ℝ F] {c : Space d → ℝ} - (hc : IsDistBounded c) (f : F) : IsDistBounded (fun x => c x • f) := by - apply IsDistBounded.congr (f := fun x => (c x) * ‖f‖) - · fun_prop - · fun_prop - · intro x - simp [norm_smul] + (hc : IsDistBounded c) (f : F) : IsDistBounded (fun x => c x • f) := + (hc.mul_const_fun ‖f‖).congr (by fun_prop) fun x => by simp [norm_smul] /-! ## E. Specific functions that are `IsDistBounded` @@ -868,11 +690,8 @@ lemma smul_const {d : ℕ} [NormedSpace ℝ F] {c : Space d → ℝ} @[fun_prop] lemma const {d : ℕ} (f : F) : - IsDistBounded (d := d) (fun _ : Space d => f) := by - apply And.intro - · fun_prop - use 1, fun _ => ‖f‖, fun _ => 0, fun _ => 0 - simp + IsDistBounded (d := d) (fun _ : Space d => f) := + ⟨by fun_prop, 1, fun _ => ‖f‖, fun _ => 0, fun _ => 0, by simp⟩ /-! @@ -882,38 +701,21 @@ lemma const {d : ℕ} (f : F) : @[fun_prop] lemma pow {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) ≤ n) : - IsDistBounded (d := d) (fun x => ‖x‖ ^ n) := by - apply And.intro - · apply AEMeasurable.aestronglyMeasurable - fun_prop - refine ⟨1, fun _ => 1, fun _ => 0, fun _ => n, ?_, ?_, ?_⟩ - · simp - · simp - exact hn - · intro x - simp + IsDistBounded (d := d) (fun x => ‖x‖ ^ n) := + ⟨AEMeasurable.aestronglyMeasurable (by fun_prop), 1, fun _ => 1, fun _ => 0, fun _ => n, + fun _ => zero_le_one, fun _ => hn, fun x => by simp⟩ @[fun_prop] lemma pow_shift {d : ℕ} (n : ℤ) (g : Space d) (hn : - (d - 1 : ℕ) ≤ n) : - IsDistBounded (d := d) (fun x => ‖x - g‖ ^ n) := by - apply And.intro - · apply AEMeasurable.aestronglyMeasurable - fun_prop - refine ⟨1, fun _ => 1, fun _ => (- g), fun _ => n, ?_, ?_, ?_⟩ - · simp - · simp - exact hn - · intro x - simp - rfl + IsDistBounded (d := d) (fun x => ‖x - g‖ ^ n) := + ⟨AEMeasurable.aestronglyMeasurable (by fun_prop), 1, fun _ => 1, fun _ => - g, fun _ => n, + fun _ => zero_le_one, fun _ => hn, fun x => by simp [sub_eq_add_neg]⟩ @[fun_prop] lemma inv_shift {d : ℕ} (g : Space d) (hd : 2 ≤ d := by omega) : IsDistBounded (d := d) (fun x => ‖x - g‖⁻¹) := by - convert IsDistBounded.pow_shift (d := d) (-1) g (by omega) using 1 - ext1 x - simp + simpa using IsDistBounded.pow_shift (d := d) (-1) g (by omega) @[fun_prop] lemma nat_pow {d : ℕ} (n : ℕ) : IsDistBounded (d := d) (fun x => ‖x‖ ^ n) := by @@ -922,12 +724,8 @@ lemma nat_pow {d : ℕ} (n : ℕ) : @[fun_prop] lemma norm_add_nat_pow {d : ℕ} (n : ℕ) (a : ℝ) : IsDistBounded (d := d) (fun x => (‖x‖ + a) ^ n) := by - conv => - enter [1, x] - rw [add_pow] - apply IsDistBounded.sum_fun - intro i _ - fun_prop + simp only [add_pow] + exact sum_fun fun i _ => by fun_prop @[fun_prop] lemma norm_add_pos_nat_zpow {d : ℕ} (n : ℤ) (a : ℝ) (ha : 0 < a) : @@ -935,132 +733,81 @@ lemma norm_add_pos_nat_zpow {d : ℕ} (n : ℤ) (a : ℝ) (ha : 0 < a) : match n with | Int.ofNat n => fun_prop | Int.negSucc n => - apply IsDistBounded.mono (f := fun x => (a ^ ((n + 1)))⁻¹) - · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp only [zpow_negSucc, norm_inv, norm_pow, Real.norm_eq_abs] - refine inv_anti₀ (by positivity) ?_ - refine (pow_le_pow_iff_left₀ (by positivity) (by positivity) (by simp)).mpr ?_ - rw [abs_of_nonneg (by positivity), abs_of_nonneg (by positivity)] - simp + refine IsDistBounded.mono (f := fun x => (a ^ ((n + 1)))⁻¹) (by fun_prop) + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + simp only [zpow_negSucc, norm_inv, norm_pow, Real.norm_eq_abs, abs_of_nonneg ha.le, + abs_of_nonneg (show (0:ℝ) ≤ ‖x‖ + a by positivity)] + exact inv_anti₀ (by positivity) (pow_le_pow_left₀ ha.le (by simp) _) @[fun_prop] lemma nat_pow_shift {d : ℕ} (n : ℕ) (g : Space d) : - IsDistBounded (d := d) (fun x => ‖x - g‖ ^ n) := by - exact IsDistBounded.pow_shift (d := d) (n : ℤ) g (by omega) + IsDistBounded (d := d) (fun x => ‖x - g‖ ^ n) := + IsDistBounded.pow_shift (d := d) (n : ℤ) g (by omega) @[fun_prop] lemma norm_sub {d : ℕ} (g : Space d) : IsDistBounded (d := d) (fun x => ‖x - g‖) := by - convert IsDistBounded.nat_pow_shift (d := d) 1 g using 1 - ext1 x - simp + simpa using IsDistBounded.nat_pow_shift (d := d) 1 g @[fun_prop] lemma norm_add {d : ℕ} (g : Space d) : IsDistBounded (d := d) (fun x => ‖x + g‖) := by - convert IsDistBounded.nat_pow_shift (d := d) 1 (- g) using 1 - ext1 x - simp + simpa using IsDistBounded.nat_pow_shift (d := d) 1 (- g) @[fun_prop] lemma inv {d : ℕ} (hd: 2 ≤ d := by omega): IsDistBounded (d := d) (fun x => ‖x‖⁻¹) := by - convert IsDistBounded.pow (d := d) (-1) (by omega) using 1 - ext1 x - simp + simpa using IsDistBounded.pow (d := d) (-1) (by omega) @[fun_prop] lemma norm {d : ℕ} : IsDistBounded (d := d) (fun x => ‖x‖) := by - convert IsDistBounded.nat_pow (d := d) 1 using 1 - ext1 x - simp + simpa using IsDistBounded.nat_pow (d := d) 1 @[fun_prop] lemma log_norm {d : ℕ} (hd : 2 ≤ d := by omega) : IsDistBounded (d := d) (fun x => Real.log ‖x‖) := by - apply IsDistBounded.mono (f := fun x => ‖x‖⁻¹ + ‖x‖) - · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp only [Real.norm_eq_abs] - conv_rhs => rw [abs_of_nonneg (by positivity)] - have h1 := Real.neg_inv_le_log (x := ‖x‖) (by positivity) - have h2 := Real.log_le_rpow_div (x := ‖x‖) (by positivity) (ε := 1) (by positivity) - simp_all - rw [abs_le'] - generalize Real.log ‖x‖ = r at * - apply And.intro - · apply h2.trans - simp - · rw [neg_le] - apply le_trans _ h1 - simp + refine IsDistBounded.mono (f := fun x => ‖x‖⁻¹ + ‖x‖) (by fun_prop) + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + have h1 := Real.neg_inv_le_log (x := ‖x‖) (norm_nonneg x) + have h2 := Real.log_le_rpow_div (x := ‖x‖) (norm_nonneg x) one_pos + simp only [Real.rpow_one, div_one] at h2 + rw [Real.norm_eq_abs, Real.norm_eq_abs, + abs_of_nonneg (show (0:ℝ) ≤ ‖x‖⁻¹ + ‖x‖ by positivity), abs_le'] + constructor + · exact h2.trans (by simp) + · linarith [norm_nonneg x] lemma zpow_smul_self {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) - 1 ≤ n) : IsDistBounded (d := d) (fun x => ‖x‖ ^ n • x) := by by_cases hzero : n = -1 - · apply IsDistBounded.mono (f := fun x => (1 : ℝ)) - · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp [norm_smul] - subst hzero - simp only [Int.reduceNeg, zpow_neg, zpow_one] - by_cases hx : x = 0 - · subst hx - simp - rw [inv_mul_cancel₀] - simpa using hx - apply IsDistBounded.congr (f := fun x => ‖x‖ ^ (n + 1)) - · apply pow - omega - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - by_cases hx : x = 0 - · subst hx - simp only [norm_zero, smul_zero, norm_zpow] - rw [@zero_zpow_eq] - rw [if_neg] - omega - · simp [norm_smul] - rw [zpow_add₀] - simp only [zpow_one] - ring_nf - simpa using hx + · subst hzero + refine IsDistBounded.mono (f := fun x => (1 : ℝ)) (by fun_prop) + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + simpa [norm_smul, inv_mul_eq_div] using div_self_le_one ‖x‖ + refine IsDistBounded.congr (f := fun x => ‖x‖ ^ (n + 1)) (pow _ (by omega)) + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + rcases eq_or_ne x 0 with rfl | hx + · simp [zero_zpow (n + 1) (by omega)] + · simp [norm_smul, zpow_add₀ (norm_ne_zero_iff.mpr hx), mul_comm] lemma zpow_smul_repr_self {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) - 1 ≤ n) : - IsDistBounded (d := d) (fun x => ‖x‖ ^ n • basis.repr x) := by - apply IsDistBounded.congr (f := fun x => ‖x‖ ^ n • x) - · apply zpow_smul_self - exact hn - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp [norm_smul] + IsDistBounded (d := d) (fun x => ‖x‖ ^ n • basis.repr x) := + (zpow_smul_self n hn).congr (AEMeasurable.aestronglyMeasurable (by fun_prop)) + fun x => by simp [norm_smul] lemma zpow_smul_repr_self_sub {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) - 1 ≤ n) (y : Space d) : - IsDistBounded (d := d) (fun x => ‖x - y‖ ^ n • basis.repr (x - y)) := by - apply (zpow_smul_repr_self n hn).comp_sub_right y + IsDistBounded (d := d) (fun x => ‖x - y‖ ^ n • basis.repr (x - y)) := + (zpow_smul_repr_self n hn).comp_sub_right y lemma inv_pow_smul_self {d : ℕ} (n : ℕ) (hn : - (d - 1 : ℕ) - 1 ≤ (- n : ℤ)) : IsDistBounded (d := d) (fun x => ‖x‖⁻¹ ^ n • x) := by - convert zpow_smul_self (n := - (n : ℤ)) (by omega) using 1 - funext x - simp + simpa using zpow_smul_self (n := - (n : ℤ)) (by omega) lemma inv_pow_smul_repr_self {d : ℕ} (n : ℕ) (hn : - (d - 1 : ℕ) - 1 ≤ (- n : ℤ)) : IsDistBounded (d := d) (fun x => ‖x‖⁻¹ ^ n • basis.repr x) := by - convert zpow_smul_repr_self (n := - (n : ℤ)) (by omega) using 1 - funext x - simp + simpa using zpow_smul_repr_self (n := - (n : ℤ)) (by omega) /-! @@ -1070,31 +817,15 @@ lemma inv_pow_smul_repr_self {d : ℕ} (n : ℕ) (hn : - (d - 1 : ℕ) - 1 ≤ ( lemma norm_smul_nat_pow {d} (p : ℕ) (c : Space d) : IsDistBounded (fun x => ‖x‖ * ‖x + c‖ ^ p) := by - apply IsDistBounded.mono (f := fun x => ‖x‖ * (‖x‖ + ‖c‖) ^ p) - · conv => - enter [1, x] - rw [add_pow] - rw [Finset.mul_sum] - apply IsDistBounded.sum_fun - intro i _ - conv => - enter [1, x] - rw [← mul_assoc, ← mul_assoc] - apply IsDistBounded.mul_const_fun - apply IsDistBounded.mul_const_fun - convert IsDistBounded.nat_pow (n := i + 1) using 1 - funext x - ring - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp [norm_mul, norm_pow, Real.norm_eq_abs] + refine IsDistBounded.mono (f := fun x => ‖x‖ * (‖x‖ + ‖c‖) ^ p) ?_ + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + · simp only [add_pow, Finset.mul_sum, ← mul_assoc] + refine IsDistBounded.sum_fun fun i _ => mul_const_fun (mul_const_fun ?_ _) _ + simpa [pow_succ'] using IsDistBounded.nat_pow (d := d) (i + 1) + · simp [norm_mul, norm_pow, Real.norm_eq_abs] rw [abs_of_nonneg (by positivity)] - have h1 : ‖x + c‖ ≤ ‖x‖ + ‖c‖ := norm_add_le x c - have h2 : ‖x + c‖ ^ p ≤ (‖x‖ + ‖c‖) ^ p := by - refine pow_le_pow_left₀ (by positivity) h1 p - apply (mul_le_mul (by rfl) h2 (by positivity) (by positivity)).trans - rfl + gcongr + exact norm_add_le x c lemma norm_smul_zpow {d} (p : ℤ) (c : Space d) (hn : - (d - 1 : ℕ) ≤ p) : IsDistBounded (fun x => ‖x‖ * ‖x + c‖ ^ p) := by @@ -1102,81 +833,48 @@ lemma norm_smul_zpow {d} (p : ℤ) (c : Space d) (hn : - (d - 1 : ℕ) ≤ p) : | Int.ofNat p => exact norm_smul_nat_pow p c | Int.negSucc p => suffices h0 : IsDistBounded (fun x => ‖x - c‖ * (‖x‖ ^ (p + 1))⁻¹) by - convert h0.comp_sub_right (- c) using 1 - funext x - simp + simpa using h0.comp_sub_right (- c) suffices h0 : IsDistBounded (fun x => (‖x‖ + ‖c‖) * (‖x‖ ^ (p + 1))⁻¹) by - apply h0.mono - · fun_prop - · intro x - simp [norm_mul, norm_inv, norm_pow, Real.norm_eq_abs] - rw [abs_of_nonneg (by positivity)] - apply mul_le_mul (norm_sub_le x c) (by rfl) (by positivity) (by positivity) + refine h0.mono (by fun_prop) fun x => ?_ + simp [norm_mul, norm_inv, norm_pow, Real.norm_eq_abs] + rw [abs_of_nonneg (by positivity)] + gcongr + exact norm_sub_le x c suffices h0 : IsDistBounded (fun x => ‖x‖ * (‖x‖ ^ (p + 1))⁻¹ + ‖c‖ * (‖x‖ ^ (p + 1))⁻¹) by - convert h0 using 1 - funext x - ring + simpa [add_mul] using h0 suffices h0 : IsDistBounded (fun x => ‖x‖ * (‖x‖ ^ (p + 1))⁻¹) by - apply h0.add - · apply IsDistBounded.const_mul_fun - exact IsDistBounded.pow (d := d) (n := -(p + 1)) (by grind) + refine h0.add (const_mul_fun ?_ ‖c‖) + exact IsDistBounded.pow (d := d) (n := -(p + 1)) (by grind) by_cases hp : p = 0 · subst hp simp only [zero_add, pow_one] - apply IsDistBounded.mono (f := fun x => (1 : ℝ)) - · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp only [norm_mul, norm_norm, norm_inv, one_mem, CStarRing.norm_of_mem_unitary] - by_cases hx : ‖x‖ ≠ 0 - · rw [mul_inv_cancel₀ (by positivity)] - · simp at hx - subst hx - simp + refine IsDistBounded.mono (f := fun x => (1 : ℝ)) (by fun_prop) + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + simpa [← div_eq_mul_inv] using div_self_le_one ‖x‖ convert IsDistBounded.pow (d := d) (n := - p) (by grind) using 1 funext x - trans (‖x‖ ^ p)⁻¹; swap - · rw [@zpow_neg] - simp - by_cases hx : ‖x‖ ≠ 0 - field_simp - ring - simp at hx - subst hx - simp only [norm_zero, ne_eq, Nat.add_eq_zero_iff, one_ne_zero, and_false, not_false_eq_true, - zero_pow, inv_zero, mul_zero, zero_eq_inv] - rw [@zero_pow_eq] - simp [hp] + rw [zpow_neg, zpow_natCast] + rcases eq_or_ne ‖x‖ 0 with hx | hx + · simp [hx, zero_pow hp] + · field_simp + ring @[fun_prop] lemma norm_smul_isDistBounded {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} (hf : IsDistBounded f) : IsDistBounded (fun x => ‖x‖ • f x) := by obtain ⟨hae, ⟨n, c, g, p, c_nonneg, p_bound, bound⟩⟩ := hf - apply IsDistBounded.mono (f := fun x => ‖x‖ * ∑ i, (c i * ‖x + g i‖ ^ (p i))) - · apply IsDistBounded.congr (f := fun x => ∑ i, (c i * (‖x‖ * ‖x + g i‖ ^ (p i)))) - · apply IsDistBounded.sum_fun - intro i _ - apply IsDistBounded.const_mul_fun - exact norm_smul_zpow (p i) (g i) (p_bound i) - · fun_prop - · intro x - congr - rw [Finset.mul_sum] - congr - funext i - ring - · fun_prop - · intro x - simp [_root_.norm_smul] - apply (mul_le_mul (by rfl) (bound x) (by positivity) (by positivity)).trans - rw [abs_of_nonneg] - apply Finset.sum_nonneg - intro i _ - apply mul_nonneg - · exact c_nonneg i - · positivity + refine IsDistBounded.mono (f := fun x => ‖x‖ * ∑ i, (c i * ‖x + g i‖ ^ (p i))) + (IsDistBounded.congr (f := fun x => ∑ i, (c i * (‖x‖ * ‖x + g i‖ ^ (p i)))) + (sum_fun fun i _ => const_mul_fun (norm_smul_zpow (p i) (g i) (p_bound i)) (c i)) + (by fun_prop) fun x => ?_) (by fun_prop) fun x => ?_ + · rw [Finset.mul_sum] + congr 1 + exact Finset.sum_congr rfl fun i _ => mul_left_comm _ _ _ + · have h : (0:ℝ) ≤ ∑ i, c i * ‖x + g i‖ ^ p i := + Finset.sum_nonneg fun i _ => mul_nonneg (c_nonneg i) (by positivity) + simp only [_root_.norm_smul, Real.norm_eq_abs, abs_mul, abs_norm, abs_of_nonneg h] + exact mul_le_mul_of_nonneg_left (bound x) (norm_nonneg x) @[fun_prop] lemma norm_mul_isDistBounded {d : ℕ} {f : Space d → ℝ} @@ -1187,19 +885,12 @@ lemma norm_mul_isDistBounded {d : ℕ} {f : Space d → ℝ} lemma component_smul_isDistBounded {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} (hf : IsDistBounded f) (i : Fin d) : IsDistBounded (fun x => x i • f x) := by - apply IsDistBounded.mono (f := fun x => ‖x‖ • f x) - · fun_prop - · apply AEStronglyMeasurable.smul - · have h1 : AEStronglyMeasurable (fun x => Space.coordCLM i x) := by - fun_prop - convert h1 using 1 - funext i - simp [coordCLM_apply, coord_apply] - · fun_prop - · intro x - simp [norm_smul] - apply mul_le_mul ?_ (by rfl) (by positivity) (by positivity) - exact abs_eval_le_norm x i + refine IsDistBounded.mono (f := fun x => ‖x‖ • f x) (by fun_prop) + (AEStronglyMeasurable.smul ?_ (by fun_prop)) fun x => ?_ + · simpa [coordCLM_apply, coord_apply] using + (by fun_prop : AEStronglyMeasurable (fun x => Space.coordCLM i x)) + · simp [norm_smul] + exact mul_le_mul_of_nonneg_right (abs_eval_le_norm x i) (by positivity) @[fun_prop] lemma component_mul_isDistBounded {d : ℕ} {f : Space d → ℝ} @@ -1209,59 +900,34 @@ lemma component_mul_isDistBounded {d : ℕ} {f : Space d → ℝ} @[fun_prop] lemma isDistBounded_smul_self {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) : IsDistBounded (fun x => f x • x) := by - apply IsDistBounded.congr (f := fun x => ‖x‖ * f x) - · fun_prop - · apply AEStronglyMeasurable.smul - · fun_prop - · fun_prop - · intro x - simp [norm_smul] - ring + refine IsDistBounded.congr (f := fun x => ‖x‖ * f x) (by fun_prop) + (AEStronglyMeasurable.smul (by fun_prop) (by fun_prop)) fun x => ?_ + simp [norm_smul, mul_comm] @[fun_prop] lemma isDistBounded_smul_self_repr {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) : IsDistBounded (fun x => f x • basis.repr x) := by - apply IsDistBounded.congr (f := fun x => ‖x‖ * f x) - · fun_prop - · apply AEStronglyMeasurable.smul - · fun_prop - · fun_prop - · intro x - simp [norm_smul] - ring + refine IsDistBounded.congr (f := fun x => ‖x‖ * f x) (by fun_prop) + (AEStronglyMeasurable.smul (by fun_prop) (by fun_prop)) fun x => ?_ + simp [norm_smul, mul_comm] @[fun_prop] lemma isDistBounded_smul_inner {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} (hf : IsDistBounded f) (y : Space d) : IsDistBounded (fun x => ⟪y, x⟫_ℝ • f x) := by have h1 (x : Space d) : ⟪y, x⟫_ℝ • f x = ∑ i, (y i * x i) • f x := by rw [inner_eq_sum, ← Finset.sum_smul] - conv => - enter [1, x] - rw [h1 x] - apply IsDistBounded.sum_fun - intro i _ - simp [← smul_smul] - refine const_fun_smul ?_ (y i) - fun_prop + simp only [h1, ← smul_smul] + exact sum_fun fun i _ => const_fun_smul (by fun_prop) (y i) lemma isDistBounded_smul_inner_of_smul_norm {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} (hf : IsDistBounded (fun x => ‖x‖ • f x)) (hae : AEStronglyMeasurable f) (y : Space d) : IsDistBounded (fun x => ⟪y, x⟫_ℝ • f x) := by have h1 (x : Space d) : ⟪y, x⟫_ℝ • f x = ∑ i, (y i * x i) • f x := by rw [inner_eq_sum, ← Finset.sum_smul] - conv => - enter [1, x] - rw [h1 x] - apply IsDistBounded.sum_fun - intro i _ - simp [← smul_smul] - refine const_fun_smul ?_ (y i) - apply hf.mono - · fun_prop - · intro x - simp [norm_smul] - refine mul_le_mul_of_nonneg_right ?_ (by positivity) - exact abs_eval_le_norm x i + simp only [h1, ← smul_smul] + refine sum_fun fun i _ => const_fun_smul (hf.mono (by fun_prop) fun x => ?_) (y i) + simp [norm_smul] + exact mul_le_mul_of_nonneg_right (abs_eval_le_norm x i) (by positivity) @[fun_prop] lemma isDistBounded_mul_inner {d : ℕ} {f : Space d → ℝ} @@ -1270,9 +936,7 @@ lemma isDistBounded_mul_inner {d : ℕ} {f : Space d → ℝ} lemma isDistBounded_mul_inner' {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) (y : Space d) : IsDistBounded (fun x => ⟪x, y⟫_ℝ * f x) := by - convert! hf.isDistBounded_smul_inner y using 2 - rw [real_inner_comm] - simp + simpa only [smul_eq_mul, real_inner_comm y] using hf.isDistBounded_smul_inner y lemma isDistBounded_mul_inner_of_smul_norm {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded (fun x => ‖x‖ * f x)) (hae : AEStronglyMeasurable f) (y : Space d) : @@ -1281,27 +945,18 @@ lemma isDistBounded_mul_inner_of_smul_norm {d : ℕ} {f : Space d → ℝ} @[fun_prop] lemma mul_inner_pow_neg_two {d : ℕ} (y : Space d) (hd : 2 ≤ d := by omega) : IsDistBounded (fun x => ⟪y, x⟫_ℝ * ‖x‖ ^ (- 2 : ℤ)) := by - apply IsDistBounded.mono (f := fun x => (‖y‖ * ‖x‖) * ‖x‖ ^ (- 2 : ℤ)) - · simp [mul_assoc] - apply IsDistBounded.const_mul_fun - apply IsDistBounded.congr (f := fun x => ‖x‖ ^ (- 1 : ℤ)) - · apply IsDistBounded.pow (d := d) (-1) (by omega) - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp only [norm_mul, norm_norm, norm_inv, norm_zpow, Int.reduceNeg, zpow_neg, zpow_one] - by_cases hx : x = 0 - · subst hx - simp - have hx' : ‖x‖ ≠ 0 := by - simpa using hx - field_simp - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp - apply mul_le_mul_of_nonneg _ (by rfl) (by positivity) (by positivity) - exact abs_real_inner_le_norm y x + refine IsDistBounded.mono (f := fun x => (‖y‖ * ‖x‖) * ‖x‖ ^ (- 2 : ℤ)) ?_ + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_ + · simp only [mul_assoc] + refine IsDistBounded.const_mul_fun (IsDistBounded.congr (f := fun x => ‖x‖ ^ (- 1 : ℤ)) + (IsDistBounded.pow (d := d) (-1) (by omega)) + (AEMeasurable.aestronglyMeasurable (by fun_prop)) fun x => ?_) ‖y‖ + simp only [norm_mul, norm_norm, norm_inv, norm_zpow, Int.reduceNeg, zpow_neg, zpow_one] + rcases eq_or_ne x 0 with rfl | hx + · simp + · field_simp [norm_ne_zero_iff.mpr hx] + · simp + exact mul_le_mul_of_nonneg (abs_real_inner_le_norm y x) (by rfl) (by positivity) (by positivity) end constructors end IsDistBounded diff --git a/Physlib/SpaceAndTime/Space/Module.lean b/Physlib/SpaceAndTime/Space/Module.lean index 94afdb17f..9c33f63de 100644 --- a/Physlib/SpaceAndTime/Space/Module.lean +++ b/Physlib/SpaceAndTime/Space/Module.lean @@ -65,7 +65,7 @@ lemma add_val {d: ℕ} (x y : Space d) : @[simp] lemma add_apply {d : ℕ} (x y : Space d) (i : Fin d) : (x + y) i = x i + y i := by - simp [add_val] + simp instance {d} : AddCommMonoid (Space d) where add_assoc a b c:= by @@ -96,9 +96,8 @@ lemma nsmul_apply {d : ℕ} (n : ℕ) (a : Space d) (i : Fin d) : lemma eq_vadd_zero {d} (s : Space d) : ∃ v : EuclideanSpace ℝ (Fin d), s = v +ᵥ (0 : Space d) := by - obtain ⟨v, h⟩ := vadd_transitive 0 s - use v - rw [h] + obtain ⟨v, rfl⟩ := vadd_transitive 0 s + exact ⟨v, rfl⟩ @[simp] lemma add_vadd_zero {d} (v1 v2 : EuclideanSpace ℝ (Fin d)) : @@ -135,19 +134,16 @@ instance {d} : Module ℝ (Space d) where simp mul_smul a b x := by ext i - simp only [smul_apply] - ring + simp [mul_assoc] smul_add a x y := by ext i - simp only [smul_apply, add_apply] - ring + simp [mul_add] smul_zero a := by ext i simp add_smul a b x := by ext i - simp only [smul_apply, add_apply] - ring + simp [add_mul] zero_smul x := by ext i simp @@ -167,21 +163,17 @@ lemma norm_eq {d} (p : Space d) : ‖p‖ = √ (∑ i, (p i) ^ 2) := by @[simp] lemma abs_eval_le_norm {d} (p : Space d) (i : Fin d) : |p i| ≤ ‖p‖ := by - simp [norm_eq] - refine Real.abs_le_sqrt ?_ - trans ∑ j ∈ {i}, (p j) ^ 2 - · simp - refine Finset.sum_le_univ_sum_of_nonneg (fun i => by positivity) + rw [norm_eq] + exact Real.abs_le_sqrt + (Finset.single_le_sum (f := fun j => (p j) ^ 2) (fun j _ => by positivity) (Finset.mem_univ i)) lemma norm_sq_eq {d} (p : Space d) : ‖p‖ ^ 2 = ∑ i, (p i) ^ 2 := by rw [norm_eq] - refine Real.sq_sqrt ?_ - positivity + exact Real.sq_sqrt (by positivity) -lemma point_dim_zero_eq (p : Space 0) : p = 0 := by - ext i - fin_cases i +lemma point_dim_zero_eq (p : Space 0) : p = 0 := + Subsingleton.elim p 0 @[simp] lemma norm_vadd_zero {d} (v : EuclideanSpace ℝ (Fin d)) : @@ -221,7 +213,7 @@ noncomputable instance {d} : AddCommGroup (Space d) where @[simp] lemma sub_apply {d} (p q : Space d) (i : Fin d) : (p - q) i = p i - q i := by - simp [sub_eq_add_neg, neg_apply, add_apply] + simp [sub_eq_add_neg] @[simp] lemma sub_val {d} (p q : Space d) : @@ -231,7 +223,7 @@ lemma sub_val {d} (p q : Space d) : lemma vadd_zero_sub_vadd_zero {d} (v1 v2 : EuclideanSpace ℝ (Fin d)) : (v1 +ᵥ (0 : Space d)) - (v2 +ᵥ (0 : Space d)) = (v1 - v2) +ᵥ (0 : Space d) := by ext i - simp [sub_apply, vadd_apply] + simp @[simp] lemma dist_eq_norm {d} (p q : Space d) : @@ -239,17 +231,13 @@ lemma dist_eq_norm {d} (p q : Space d) : noncomputable instance {d} : SeminormedAddCommGroup (Space d) where dist_eq x y := by - simp [dist_eq_norm, norm_eq] - congr - funext i - ring + simp [dist_eq_norm, norm_eq, sub_apply] + exact congrArg _ (Finset.sum_congr rfl fun i _ => by ring) noncomputable instance : NormedAddCommGroup (Space d) where dist_eq x y := by - simp [dist_eq_norm, norm_eq] - congr - funext i - ring + simp [dist_eq_norm, norm_eq, sub_apply] + exact congrArg _ (Finset.sum_congr rfl fun i _ => by ring) instance {d} : Inner ℝ (Space d) where inner p q := ∑ i, p i * q i @@ -257,10 +245,7 @@ instance {d} : Inner ℝ (Space d) where @[simp] lemma inner_vadd_zero {d} (v1 v2 : EuclideanSpace ℝ (Fin d)) : inner ℝ (v1 +ᵥ (0 : Space d)) (v2 +ᵥ (0 : Space d)) = Inner.inner ℝ v1 v2 := by - simp [inner, vadd_apply] - apply Finset.sum_congr rfl - intro i hi - ring + simp [inner, vadd_apply, mul_comm] lemma inner_apply {d} (p q : Space d) : inner ℝ p q = ∑ i, p i * q i := by rfl @@ -268,27 +253,22 @@ lemma inner_apply {d} (p q : Space d) : instance {d} : InnerProductSpace ℝ (Space d) where norm_smul_le a x := by obtain ⟨v, rfl⟩ := eq_vadd_zero x - simp only [smul_vadd_zero, norm_vadd_zero, Real.norm_eq_abs] - exact norm_smul_le a v + simpa only [smul_vadd_zero, norm_vadd_zero, Real.norm_eq_abs] using norm_smul_le a v norm_sq_eq_re_inner x := by obtain ⟨v, rfl⟩ := eq_vadd_zero x simp conj_inner_symm x y := by - simp [inner_apply] - congr - funext i - ring + simp [inner_apply, mul_comm] add_left x y z := by obtain ⟨v1, rfl⟩ := eq_vadd_zero x obtain ⟨v2, rfl⟩ := eq_vadd_zero y obtain ⟨v3, rfl⟩ := eq_vadd_zero z - simp only [add_vadd_zero, inner_vadd_zero] - exact InnerProductSpace.add_left v1 v2 v3 + simpa only [add_vadd_zero, inner_vadd_zero] using InnerProductSpace.add_left v1 v2 v3 smul_left x y a := by obtain ⟨v1, rfl⟩ := eq_vadd_zero x obtain ⟨v2, rfl⟩ := eq_vadd_zero y - simp only [smul_vadd_zero, inner_vadd_zero, conj_trivial] - exact InnerProductSpace.smul_left v1 v2 a + simpa only [smul_vadd_zero, inner_vadd_zero, conj_trivial] + using InnerProductSpace.smul_left v1 v2 a lemma norm_smul_sphere {d : ℕ} (n : ↑(Metric.sphere (0 : Space d) 1)) {r : ℝ} (hr : 0 ≤ r) : @@ -393,9 +373,7 @@ lemma basis_repr_symm_apply {d} (v : EuclideanSpace ℝ (Fin d)) (i : Fin d) : lemma basis_apply {d} (i j : Fin d) : basis i j = if i = j then 1 else 0 := by - simp [apply_eq_basis_repr_apply] - congr 1 - exact Lean.Grind.eq_congr' rfl rfl + simp [apply_eq_basis_repr_apply, eq_comm] @[simp] lemma basis_self {d} (i : Fin d) : basis i i = 1 := by @@ -414,8 +392,8 @@ lemma basis_inner {d} (i : Fin d) (p : Space d) : open InnerProductSpace lemma basis_repr_inner_eq {d} (p : Space d) (v : EuclideanSpace ℝ (Fin d)) : - ⟪basis.repr p, v⟫_ℝ = ⟪p, basis.repr.symm v⟫_ℝ := by - exact LinearIsometryEquiv.inner_map_eq_flip basis.repr p v + ⟪basis.repr p, v⟫_ℝ = ⟪p, basis.repr.symm v⟫_ℝ := + LinearIsometryEquiv.inner_map_eq_flip basis.repr p v instance {d : ℕ} : FiniteDimensional ℝ (Space d) := Module.Basis.finiteDimensional_of_finite (h := basis.toBasis) @@ -445,23 +423,7 @@ lemma basis_induction_on {d} {P : Space d → Prop} (hadd : ∀ p1 p2, P p1 → P p2 → P (p1 + p2)) (hsmul : ∀ (c : ℝ) p, P p → P (c • p)) (p : Space d) : P p := by rw [← OrthonormalBasis.sum_repr basis p] - have hp_sum (s : Finset (Fin d)) (f : (Fin d) → Space d) - (hi : ∀ i ∈ s, P (f i)) : P (∑ x ∈ s, f x) := by - induction' s using Finset.induction with i s hi ih - · simpa using hzero - · rw [Finset.sum_insert] - apply hadd - · apply hi - simp - · apply ih - intro i h' - apply hi - simp_all - simp_all - apply hp_sum - intro i _ - apply hsmul - apply hb + exact Finset.sum_induction _ P hadd hzero fun i _ => hsmul _ _ (hb i) /-! ## Coordinates @@ -492,9 +454,8 @@ noncomputable def coordCLM {d} (μ : Fin d) : Space d →L[ℝ] ℝ where open ContDiff @[fun_prop] -lemma coord_contDiff {i} : ContDiff ℝ ∞ (fun x : Space d => x.coord i) := by - change ContDiff ℝ ∞ (coordCLM i) - fun_prop +lemma coord_contDiff {i} : ContDiff ℝ ∞ (fun x : Space d => x.coord i) := + (coordCLM i).contDiff lemma coordCLM_apply (μ : Fin d) (p : Space d) : coordCLM μ p = coord μ p := by @@ -564,20 +525,15 @@ lemma fderiv_val {d : ℕ} (p : Space d) : @[simp] lemma fderiv_eval_apply {d : ℕ} (p y : Space d) (i : Fin d) : fderiv ℝ (fun p => p.val i) p y = y i := by - trans fderiv ℝ (Space.coordCLM i) p y - · congr - funext i - simp [Space.coordCLM, Space.coord_apply] - simp only [ContinuousLinearMap.fderiv] - simp [Space.coordCLM, Space.coord_apply] + have h : (fun p : Space d => p.val i) = ⇑(coordCLM i) := + funext fun q => by simp [coordCLM, coord_apply] + rw [h, ContinuousLinearMap.fderiv] + simp [coordCLM, coord_apply] @[fun_prop] lemma contDiffOn_vadd (s : Space d) : - ContDiffOn ℝ ω (fun (v : EuclideanSpace ℝ (Fin d)) => v +ᵥ s) Set.univ := by - rw [contDiffOn_univ] - refine fun_comp ?_ ?_ - · exact mk_contDiff (n := ω) - · fun_prop + ContDiffOn ℝ ω (fun (v : EuclideanSpace ℝ (Fin d)) => v +ᵥ s) Set.univ := + contDiffOn_univ.mpr <| fun_comp (mk_contDiff (n := ω)) (by fun_prop) @[fun_prop] lemma vadd_differentiable {d} (s : Space d) : @@ -625,10 +581,8 @@ noncomputable def toDirection {d : ℕ} (x : Space d) (h : x ≠ 0) : Direction @[simp] lemma direction_unit_sq_sum {d} (s : Direction d) : ∑ i : Fin d, (s.unit i) ^ 2 = 1 := by - trans (‖s.unit‖) ^ 2 - · rw [norm_sq_eq] - · rw [s.norm] - simp + rw [← norm_sq_eq, s.norm] + simp /-! @@ -661,7 +615,6 @@ lemma oneEquiv_symm_coe : lemma oneEquiv_symm_apply (x : ℝ) (i : Fin 1) : oneEquiv.symm x i = x := by - fin_cases i rfl lemma oneEquiv_continuous : @@ -708,8 +661,8 @@ lemma oneEquiv_symm_measurableEmbedding : MeasurableEmbedding oneEquiv.symm wher lemma oneEquiv_measurePreserving : MeasurePreserving oneEquiv volume volume := LinearIsometryEquiv.measurePreserving oneEquiv -lemma oneEquiv_symm_measurePreserving : MeasurePreserving oneEquiv.symm volume volume := by - exact LinearIsometryEquiv.measurePreserving oneEquiv.symm +lemma oneEquiv_symm_measurePreserving : MeasurePreserving oneEquiv.symm volume volume := + LinearIsometryEquiv.measurePreserving oneEquiv.symm /-! @@ -794,27 +747,18 @@ lemma fderiv_vadd {d} (v : EuclideanSpace ℝ (Fin d)) : fderiv ℝ (fun s => v +ᵥ s) = fun (_ : Space d) => ContinuousLinearMap.id ℝ _ := by ext s ds i rw [fderiv_space_components] - simp only [vadd_apply, fderiv_const_add, ContinuousLinearMap.coe_id', id_eq] - trans fderiv ℝ (coordCLM i) s ds - · congr - ext j - simp [coordCLM, coord_apply] - · rw [ContinuousLinearMap.fderiv] - simp [coordCLM, coord_apply] + · simp [fderiv_const_add] · fun_prop @[fun_prop] lemma vadd_hasTemperateGrowth {d} (v : EuclideanSpace ℝ (Fin d)) : Function.HasTemperateGrowth (fun s : Space d => v +ᵥ s) := by apply Function.HasTemperateGrowth.of_fderiv (k := 1) (C := 1 + ‖v‖) - · rw [fderiv_vadd] - simp + · simp [fderiv_vadd] · fun_prop · intro x simp only [pow_one] apply (norm_vadd_le_add _ _).trans - have : 0 ≤ ‖v‖ := by positivity - have : 0 ≤ ‖x‖ := by positivity - nlinarith + nlinarith [norm_nonneg v, norm_nonneg x] end Space diff --git a/Physlib/SpaceAndTime/Space/Norm/Basic.lean b/Physlib/SpaceAndTime/Space/Norm/Basic.lean index 99f6cb005..17d2f3508 100644 --- a/Physlib/SpaceAndTime/Space/Norm/Basic.lean +++ b/Physlib/SpaceAndTime/Space/Norm/Basic.lean @@ -95,10 +95,8 @@ lemma normPowerSeries_eq (n : ℕ) : normPowerSeries (d := d) n = fun x => √(‖x‖ ^ 2 + 1/(n + 1)) := rfl lemma normPowerSeries_eq_rpow {d} (n : ℕ) : - normPowerSeries (d := d) n = fun x => ((‖x‖ ^ 2 + 1/(n + 1))) ^ (1/2 : ℝ) := by - rw [normPowerSeries_eq] - funext x - rw [← Real.sqrt_eq_rpow] + normPowerSeries (d := d) n = fun x => ((‖x‖ ^ 2 + 1/(n + 1))) ^ (1/2 : ℝ) := + funext fun _ => Real.sqrt_eq_rpow _ /-! @@ -109,15 +107,9 @@ lemma normPowerSeries_eq_rpow {d} (n : ℕ) : @[fun_prop] lemma normPowerSeries_differentiable {d} (n : ℕ) : Differentiable ℝ (fun (x : Space d) => normPowerSeries n x) := by - rw [normPowerSeries_eq_rpow] - refine Differentiable.rpow_const ?_ ?_ - · refine (Differentiable.fun_add_iff_right ?_).mpr ?_ - · apply Differentiable.norm_sq ℝ - fun_prop - · fun_prop - · intro x - have h1 : 0 < ‖x‖ ^ 2 + 1 / (↑n + 1) := by positivity - grind + rw [normPowerSeries_eq] + intro x + exact ((differentiable_id.norm_sq ℝ).add_const _).differentiableAt.sqrt (by positivity) /-! @@ -130,25 +122,14 @@ open scoped Topology BigOperators FourierTransform lemma normPowerSeries_tendsto {d} (x : Space d) (hx : x ≠ 0) : Filter.Tendsto (fun n => normPowerSeries n x) Filter.atTop (𝓝 (‖x‖)) := by - conv => enter [1, n]; rw [normPowerSeries_eq_rpow] - simp only [one_div] - have hx_norm : ‖x‖ = (‖x‖ ^ 2 + 0) ^ (1 / 2 : ℝ) := by - rw [← Real.sqrt_eq_rpow] - simp - conv_rhs => rw [hx_norm] - refine Filter.Tendsto.rpow ?_ ?_ ?_ - · apply Filter.Tendsto.add - · exact tendsto_const_nhds - · simpa using tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ) - · simp - · left - simpa using hx + have h := (Real.continuous_sqrt.tendsto _).comp + ((tendsto_const_nhds (x := ‖x‖ ^ 2)).add (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ))) + simpa only [normPowerSeries_eq, Function.comp_def, add_zero, + Real.sqrt_sq (norm_pos_iff.mpr hx).le] using h lemma normPowerSeries_inv_tendsto {d} (x : Space d) (hx : x ≠ 0) : - Filter.Tendsto (fun n => (normPowerSeries n x)⁻¹) Filter.atTop (𝓝 (‖x‖⁻¹)) := by - apply Filter.Tendsto.inv₀ - · exact normPowerSeries_tendsto x hx - · simpa using hx + Filter.Tendsto (fun n => (normPowerSeries n x)⁻¹) Filter.atTop (𝓝 (‖x‖⁻¹)) := + (normPowerSeries_tendsto x hx).inv₀ (norm_ne_zero_iff.mpr hx) /-! @@ -159,27 +140,19 @@ open Space lemma deriv_normPowerSeries {d} (n : ℕ) (x : Space d) (i : Fin d) : ∂[i] (normPowerSeries n) x = x i * (normPowerSeries n x)⁻¹ := by - rw [deriv_eq_fderiv_basis] - rw [normPowerSeries_eq] - rw [fderiv_sqrt] + rw [deriv_eq_fderiv_basis, normPowerSeries_eq, fderiv_sqrt] simp only [one_div, mul_inv_rev, fderiv_add_const, FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - rw [← deriv_eq_fderiv_basis] - rw [deriv_norm_sq] + rw [← deriv_eq_fderiv_basis, deriv_norm_sq] ring - · simp - apply DifferentiableAt.norm_sq ℝ - fun_prop + · exact ((differentiable_id.norm_sq ℝ).add_const _).differentiableAt · positivity lemma fderiv_normPowerSeries {d} (n : ℕ) (x y : Space d) : fderiv ℝ (fun (x : Space d) => normPowerSeries n x) x y = ⟪y, x⟫_ℝ * (normPowerSeries n x)⁻¹ := by rw [fderiv_eq_sum_deriv, inner_eq_sum, Finset.sum_mul] - congr - funext i - simp [deriv_normPowerSeries] - ring + exact Finset.sum_congr rfl fun i _ => by simp [deriv_normPowerSeries, mul_assoc] /-! @@ -189,18 +162,14 @@ lemma fderiv_normPowerSeries {d} (n : ℕ) (x y : Space d) : lemma deriv_normPowerSeries_tendsto {d} (x : Space d) (hx : x ≠ 0) (i : Fin d) : Filter.Tendsto (fun n => ∂[i] (normPowerSeries n) x) Filter.atTop (𝓝 (x i * (‖x‖)⁻¹)) := by - conv => enter [1, n]; rw [deriv_normPowerSeries] - refine Filter.Tendsto.mul ?_ ?_ - · exact tendsto_const_nhds - · exact normPowerSeries_inv_tendsto x hx + simp only [deriv_normPowerSeries] + exact tendsto_const_nhds.mul (normPowerSeries_inv_tendsto x hx) lemma fderiv_normPowerSeries_tendsto {d} (x y : Space d) (hx : x ≠ 0) : Filter.Tendsto (fun n => fderiv ℝ (fun (x : Space d) => normPowerSeries n x) x y) Filter.atTop (𝓝 (⟪y, x⟫_ℝ * (‖x‖)⁻¹)) := by - conv => enter [1, n]; rw [fderiv_normPowerSeries] - refine Filter.Tendsto.mul ?_ ?_ - · exact tendsto_const_nhds - · exact normPowerSeries_inv_tendsto x hx + simp only [fderiv_normPowerSeries] + exact tendsto_const_nhds.mul (normPowerSeries_inv_tendsto x hx) /-! @@ -210,11 +179,8 @@ lemma fderiv_normPowerSeries_tendsto {d} (x y : Space d) (hx : x ≠ 0) : @[fun_prop] lemma normPowerSeries_aestronglyMeasurable {d} (n : ℕ) : - AEStronglyMeasurable (normPowerSeries n : Space d → ℝ) volume := by - rw [normPowerSeries_eq_rpow] - refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop + AEStronglyMeasurable (normPowerSeries n : Space d → ℝ) volume := + (normPowerSeries_differentiable n).continuous.aestronglyMeasurable /-! @@ -224,100 +190,61 @@ lemma normPowerSeries_aestronglyMeasurable {d} (n : ℕ) : @[simp] lemma normPowerSeries_nonneg {d} (n : ℕ) (x : Space d) : - 0 ≤ normPowerSeries n x := by - rw [normPowerSeries_eq] - simp + 0 ≤ normPowerSeries n x := + Real.sqrt_nonneg _ @[simp] lemma normPowerSeries_pos {d} (n : ℕ) (x : Space d) : - 0 < normPowerSeries n x := by - rw [normPowerSeries_eq] - simp only [one_div, Real.sqrt_pos] - positivity + 0 < normPowerSeries n x := + Real.sqrt_pos_of_pos (by positivity) @[simp] lemma normPowerSeries_ne_zero {d} (n : ℕ) (x : Space d) : - normPowerSeries n x ≠ 0 := by - rw [normPowerSeries_eq] - simp only [one_div, ne_eq] - positivity + normPowerSeries n x ≠ 0 := + (normPowerSeries_pos n x).ne' lemma normPowerSeries_le_norm_sq_add_one {d} (n : ℕ) (x : Space d) : normPowerSeries n x ≤ ‖x‖ + 1 := by - trans √(‖x‖ ^ 2 + 1) - · rw [normPowerSeries_eq] - apply Real.sqrt_le_sqrt - simp only [one_div, add_le_add_iff_left] - refine inv_le_one_iff₀.mpr ?_ - right - simp - · refine (Real.sqrt_le_left (by positivity)).mpr ?_ - trans (‖x‖ ^ 2 + 1) + (2 * ‖x‖) - · simp - · ring_nf - rfl + rw [normPowerSeries_eq] + refine (Real.sqrt_le_left (by positivity)).mpr ?_ + have h : 1 / ((n : ℝ) + 1) ≤ 1 := div_le_one_of_le₀ (by simp) (by positivity) + nlinarith [norm_nonneg x] @[simp] lemma norm_lt_normPowerSeries {d} (n : ℕ) (x : Space d) : - ‖x‖ < normPowerSeries n x := by - rw [normPowerSeries_eq] - apply Real.lt_sqrt_of_sq_lt - simp only [one_div, lt_add_iff_pos_right, inv_pos] - positivity + ‖x‖ < normPowerSeries n x := + Real.lt_sqrt_of_sq_lt (lt_add_of_pos_right _ (by positivity)) lemma norm_le_normPowerSeries {d} (n : ℕ) (x : Space d) : - ‖x‖ ≤ normPowerSeries n x := by - rw [normPowerSeries_eq] - apply Real.le_sqrt_of_sq_le - simp only [one_div, le_add_iff_nonneg_right, inv_nonneg] - positivity + ‖x‖ ≤ normPowerSeries n x := + (norm_lt_normPowerSeries n x).le lemma normPowerSeries_zpow_le_norm_sq_add_one {d} (n : ℕ) (m : ℤ) (x : Space d) (hx : x ≠ 0) : (normPowerSeries n x) ^ m ≤ (‖x‖ + 1) ^ m + ‖x‖ ^ m := by match m with | .ofNat m => - trans (‖x‖ + 1) ^ m - · simp - refine pow_le_pow_left₀ (by simp) ?_ m - exact normPowerSeries_le_norm_sq_add_one n x - · simp + simpa using le_add_of_le_of_nonneg + (pow_le_pow_left₀ (by simp) (normPowerSeries_le_norm_sq_add_one n x) m) (by positivity) | .negSucc m => - trans (‖x‖ ^ (m + 1))⁻¹; swap - · simp - positivity simp only [zpow_negSucc] - refine inv_anti₀ ?_ ?_ - · positivity - refine pow_le_pow_left₀ (by simp) ?_ (m + 1) - exact norm_le_normPowerSeries n x + exact le_add_of_nonneg_of_le (by positivity) (inv_anti₀ (by positivity) + (pow_le_pow_left₀ (by simp) (norm_le_normPowerSeries n x) (m + 1))) lemma normPowerSeries_inv_le {d} (n : ℕ) (x : Space d) (hx : x ≠ 0) : - (normPowerSeries n x)⁻¹ ≤ ‖x‖⁻¹ := by - refine inv_anti₀ ?_ ?_ - · positivity - apply Real.le_sqrt_of_sq_le - simp only [one_div, le_add_iff_nonneg_right, inv_nonneg] - positivity + (normPowerSeries n x)⁻¹ ≤ ‖x‖⁻¹ := + inv_anti₀ (norm_pos_iff.mpr hx) (norm_le_normPowerSeries n x) lemma normPowerSeries_log_le_normPowerSeries {d} (n : ℕ) (x : Space d) : |Real.log (normPowerSeries n x)| ≤ (normPowerSeries n x)⁻¹ + (normPowerSeries n x) := by - have h1 := Real.neg_inv_le_log (x := (normPowerSeries n x)) (by simp) - have h2 := Real.log_le_rpow_div (x := (normPowerSeries n x)) (by simp) (ε := 1) (by positivity) rw [abs_le'] - generalize Real.log ‖x‖ = r at * - apply And.intro - · apply h2.trans - simp - · rw [neg_le] - apply le_trans _ h1 - simp + exact ⟨(Real.log_le_rpow_div (x := normPowerSeries n x) (by simp) one_pos).trans (by simp), + (neg_le.mp (Real.neg_inv_le_log (normPowerSeries_nonneg n x))).trans + (le_add_of_nonneg_right (normPowerSeries_nonneg n x))⟩ lemma normPowerSeries_log_le {d} (n : ℕ) (x : Space d) (hx : x ≠ 0) : - |Real.log (normPowerSeries n x)| ≤ ‖x‖⁻¹ + (‖x‖ + 1) := by - apply le_trans (normPowerSeries_log_le_normPowerSeries n x) ?_ - apply add_le_add - · exact normPowerSeries_inv_le n x hx - · exact normPowerSeries_le_norm_sq_add_one n x + |Real.log (normPowerSeries n x)| ≤ ‖x‖⁻¹ + (‖x‖ + 1) := + (normPowerSeries_log_le_normPowerSeries n x).trans + (add_le_add (normPowerSeries_inv_le n x hx) (normPowerSeries_le_norm_sq_add_one n x)) /-! @@ -343,64 +270,44 @@ lemma IsDistBounded.normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : simp only [zpow_negSucc] apply IsDistBounded.mono (f := fun (x : Space d) => ((√(1/(n + 1)) : ℝ) ^ (m + 1))⁻¹) · fun_prop - · rw [normPowerSeries_eq_rpow] - refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop + · exact (((normPowerSeries_differentiable n).continuous.pow _).inv₀ + fun x => pow_ne_zero _ (normPowerSeries_ne_zero n x)).aestronglyMeasurable · intro x simp only [norm_inv, norm_pow, Real.norm_eq_abs, one_div] - refine inv_anti₀ (by positivity) ?_ - refine (pow_le_pow_iff_left₀ (by positivity) (by positivity) (by simp)).mpr ?_ - rw [abs_of_nonneg (by positivity), abs_of_nonneg (by simp)] - rw [normPowerSeries_eq] - simp only [Real.sqrt_inv, one_div] - rw [← Real.sqrt_inv] - apply Real.sqrt_le_sqrt - simp + refine inv_anti₀ (by positivity) (pow_le_pow_left₀ (abs_nonneg _) ?_ _) + rw [abs_of_nonneg (by positivity), abs_of_nonneg (by simp), normPowerSeries_eq] + exact Real.sqrt_le_sqrt (by simp) @[fun_prop] lemma IsDistBounded.normPowerSeries_single {d : ℕ} {n : ℕ} : IsDistBounded (d := d) (fun x => (normPowerSeries n x)) := by - convert IsDistBounded.normPowerSeries_zpow (n := n) (m := 1) using 1 - simp + simpa using IsDistBounded.normPowerSeries_zpow (n := n) (m := 1) @[fun_prop] lemma IsDistBounded.normPowerSeries_inv {d : ℕ} {n : ℕ} : IsDistBounded (d := d) (fun x => (normPowerSeries n x)⁻¹) := by - convert normPowerSeries_zpow (n := n) (-1) using 1 - simp + simpa using normPowerSeries_zpow (n := n) (-1) @[fun_prop] lemma IsDistBounded.normPowerSeries_deriv {d : ℕ} (n : ℕ) (i : Fin d) : IsDistBounded (d := d) (fun x => ∂[i] (normPowerSeries n) x) := by - conv => - enter [1, x]; - rw [deriv_normPowerSeries] + simp only [deriv_normPowerSeries] fun_prop @[fun_prop] lemma IsDistBounded.normPowerSeries_fderiv {d : ℕ} (n : ℕ) (y : Space d) : IsDistBounded (d := d) (fun x => fderiv ℝ (fun (x : Space d) => normPowerSeries n x) x y) := by - conv => - enter [1, x]; - rw [fderiv_eq_sum_deriv] - apply IsDistBounded.sum_fun - fun_prop + simp only [fderiv_eq_sum_deriv] + exact IsDistBounded.sum_fun (by fun_prop) @[fun_prop] lemma IsDistBounded.normPowerSeries_log {d : ℕ} (n : ℕ) : IsDistBounded (d := d) (fun x => Real.log (normPowerSeries n x)) := by apply IsDistBounded.mono (f := fun x => (normPowerSeries n x)⁻¹ + (normPowerSeries n x)) · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop - · intro x - simp only [Real.norm_eq_abs] - conv_rhs => rw [abs_of_nonneg (by - apply add_nonneg - · simp - · simp)] - exact normPowerSeries_log_le_normPowerSeries n x + · exact ((normPowerSeries_differentiable n).continuous.log + (normPowerSeries_ne_zero n)).aestronglyMeasurable + · exact fun x => (normPowerSeries_log_le_normPowerSeries n x).trans (le_abs_self _) /-! @@ -410,26 +317,18 @@ lemma IsDistBounded.normPowerSeries_log {d : ℕ} (n : ℕ) : @[fun_prop] lemma differentiable_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : - Differentiable ℝ (fun x : Space d => (normPowerSeries n x) ^ m) := by - refine Differentiable.zpow ?_ ?_ - · fun_prop - · left - exact normPowerSeries_ne_zero n + Differentiable ℝ (fun x : Space d => (normPowerSeries n x) ^ m) := + Differentiable.zpow (by fun_prop) (.inl (normPowerSeries_ne_zero n)) @[fun_prop] lemma differentiable_normPowerSeries_inv {d : ℕ} {n : ℕ} : - Differentiable ℝ (fun x : Space d => (normPowerSeries n x)⁻¹) := by - convert differentiable_normPowerSeries_zpow (n := n) (m := -1) using 1 - funext x - simp + Differentiable ℝ (fun x : Space d => (normPowerSeries n x)⁻¹) := + Differentiable.inv (by fun_prop) (normPowerSeries_ne_zero n) @[fun_prop] lemma differentiable_log_normPowerSeries {d : ℕ} {n : ℕ} : - Differentiable ℝ (fun x : Space d => Real.log (normPowerSeries n x)) := by - refine Differentiable.log ?_ ?_ - · fun_prop - · intro x - exact normPowerSeries_ne_zero n x + Differentiable ℝ (fun x : Space d => Real.log (normPowerSeries n x)) := + Differentiable.log (by fun_prop) (normPowerSeries_ne_zero n) /-! ### A.9. Derivatives of functions @@ -441,58 +340,39 @@ lemma deriv_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) (x : Space d) (i m * x i * (normPowerSeries n x) ^ (m - 2) := by rw [deriv_eq_fderiv_basis] change (fderiv ℝ ((fun x => x ^ m) ∘ normPowerSeries n) x) (basis i) = _ - rw [fderiv_comp] + rw [show m - 2 = m - 1 - 1 by ring, zpow_sub_one₀ (normPowerSeries_ne_zero n x), fderiv_comp] simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_eq_smul_deriv, deriv_zpow', smul_eq_mul] - rw [fderiv_normPowerSeries] - simp only [basis_inner] - field_simp - ring_nf - have h1 : normPowerSeries n x ^ (-1 + m) = normPowerSeries n x ^ ((-2 + m) + 1) := by - ring_nf - rw [h1, zpow_add₀] - simp only [Int.reduceNeg, zpow_one] + rw [fderiv_normPowerSeries, basis_inner] ring - · simp - · refine DifferentiableAt.zpow ?_ ?_ - · fun_prop - · left - exact normPowerSeries_ne_zero n x + · exact differentiableAt_zpow.mpr (.inl (normPowerSeries_ne_zero n x)) · fun_prop lemma fderiv_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) (x y : Space d) : fderiv ℝ (fun x : Space d => (normPowerSeries n x) ^ m) x y = m * ⟪y, x⟫_ℝ * (normPowerSeries n x) ^ (m - 2) := by rw [fderiv_eq_sum_deriv, inner_eq_sum, Finset.mul_sum, Finset.sum_mul] - congr - funext i - simp [deriv_normPowerSeries_zpow] - ring + exact Finset.sum_congr rfl fun i _ => by + simp [deriv_normPowerSeries_zpow, mul_assoc, mul_comm, mul_left_comm] lemma deriv_log_normPowerSeries {d : ℕ} {n : ℕ} (x : Space d) (i : Fin d) : ∂[i] (fun x : Space d => Real.log (normPowerSeries n x)) x = x i * (normPowerSeries n x) ^ (-2 : ℤ) := by rw [deriv_eq_fderiv_basis] change (fderiv ℝ (Real.log ∘ normPowerSeries n) x) (basis i) = _ - rw [fderiv_comp,] + rw [fderiv_comp] simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_eq_smul_deriv, Real.deriv_log', smul_eq_mul, Int.reduceNeg, zpow_neg] - rw [fderiv_normPowerSeries] - simp [zpow_ofNat, sq] + simp [fderiv_normPowerSeries, zpow_ofNat, sq] ring - · apply DifferentiableAt.log ?_ ?_ - · fun_prop - exact normPowerSeries_ne_zero n x + · exact Real.differentiableAt_log (normPowerSeries_ne_zero n x) · fun_prop lemma fderiv_log_normPowerSeries {d : ℕ} {n : ℕ} (x y : Space d) : fderiv ℝ (fun x : Space d => Real.log (normPowerSeries n x)) x y = ⟪y, x⟫_ℝ * (normPowerSeries n x) ^ (-2 : ℤ) := by rw [fderiv_eq_sum_deriv, inner_eq_sum, Finset.sum_mul] - congr - funext i - simp [deriv_log_normPowerSeries] - ring + exact Finset.sum_congr rfl fun i _ => by simp [deriv_log_normPowerSeries, mul_assoc] /-! @@ -505,8 +385,7 @@ lemma gradient_dist_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : distOfFunction (fun x : Space d => (m * (normPowerSeries n x) ^ (m - 2)) • basis.repr x) (by fun_prop) := by ext1 η - apply ext_inner_right ℝ - intro y + refine ext_inner_right ℝ fun y => ?_ simp [distGrad_inner_eq] rw [Distribution.fderivD_apply, distOfFunction_apply, distOfFunction_inner] calc _ @@ -516,19 +395,14 @@ lemma gradient_dist_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] · fun_prop · refine IsDistBounded.integrable_space_mul ?_ η - conv => enter [1, x]; rw [fderiv_normPowerSeries_zpow] - simp [mul_assoc] + simp only [fderiv_normPowerSeries_zpow, mul_assoc] fun_prop · fun_prop · fun_prop - · intro _ _ - apply Differentiable.differentiableAt - fun_prop + · exact fun _ _ => (differentiable_normPowerSeries_zpow m).differentiableAt _ = ∫ (x : Space d), η x * (m * ⟪(basis.repr.symm y), x⟫_ℝ * (normPowerSeries n x) ^ (m - 2)) := by - congr - funext x - rw [fderiv_normPowerSeries_zpow] + simp only [fderiv_normPowerSeries_zpow] congr funext x simp [inner_smul_left_eq_smul] @@ -559,48 +433,23 @@ lemma gradient_dist_normPowerSeries_zpow_tendsTo_distGrad_norm {d : ℕ} [NeZero apply MeasureTheory.tendsto_integral_of_dominated_convergence (bound := fun x => |fderiv ℝ η x (basis.repr.symm y)| * ((‖x‖ + 1) ^ m + ‖x‖ ^ m)) · intro n - apply IsDistBounded.aeStronglyMeasurable_fderiv_schwartzMap_smul (F := ℝ) ?_ - fun_prop + exact IsDistBounded.aeStronglyMeasurable_fderiv_schwartzMap_smul (F := ℝ) (by fun_prop) η _ · have h1 : Integrable (fun x => (fderiv ℝ (⇑η) x) (basis.repr.symm y) * ((‖x‖ + 1) ^ m + ‖x‖ ^ m)) volume := by - apply IsDistBounded.integrable_space_fderiv ?_ - apply IsDistBounded.add - · refine IsDistBounded.norm_add_pos_nat_zpow m 1 ?_ - simp - · exact IsDistBounded.pow m hm - rw [← integrable_norm_iff] at h1 - convert h1 using 1 - funext x - simp only [norm_mul, Real.norm_eq_abs, mul_eq_mul_left_iff, abs_eq_zero] - left - rw [abs_of_nonneg (by positivity)] - fun_prop + apply IsDistBounded.integrable_space_fderiv + ((IsDistBounded.norm_add_pos_nat_zpow m 1 one_pos).add (IsDistBounded.pow m hm)) + refine h1.abs.congr (ae_of_all _ fun x => ?_) + simp only [abs_mul] + congr 1 + exact abs_of_nonneg (by positivity) · intro n - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp at hx - simp - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) - rw [abs_of_nonneg (by simp)] - exact normPowerSeries_zpow_le_norm_sq_add_one n m x hx - · rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - have h1 : Filter.Tendsto (fun x_1 => normPowerSeries x_1 x ^ (m : ℝ)) - Filter.atTop (𝓝 (‖x‖ ^ (m : ℝ))) := by - refine Filter.Tendsto.rpow ?_ ?_ ?_ - · apply normPowerSeries_tendsto x hx - · simp - · left - simpa using hx - simpa using h1 + filter_upwards [Measure.ae_ne volume 0] with x hx + simp [abs_of_nonneg (normPowerSeries_nonneg n x)] + exact mul_le_mul_of_nonneg_left + (normPowerSeries_zpow_le_norm_sq_add_one n m x hx) (abs_nonneg _) + · filter_upwards [Measure.ae_ne volume 0] with x hx + exact tendsto_const_nhds.mul + ((normPowerSeries_tendsto x hx).zpow₀ m (.inl (norm_ne_zero_iff.mpr hx))) lemma gradient_dist_normPowerSeries_zpow_tendsTo {d : ℕ} [NeZero d] (m : ℤ) (hm : - (d - 1 : ℕ) + 1 ≤ m) @@ -614,28 +463,21 @@ lemma gradient_dist_normPowerSeries_zpow_tendsTo {d : ℕ} [NeZero d] (m : ℤ) refine IsDistBounded.const_fun_smul ?_ ↑m apply IsDistBounded.zpow_smul_repr_self omega) η, y⟫_ℝ)) := by - conv => - enter [1, n]; - rw [gradient_dist_normPowerSeries_zpow] + simp only [gradient_dist_normPowerSeries_zpow] simp [distOfFunction_inner] have h1 (n : ℕ) (x : Space d) : η x * ⟪(↑m * normPowerSeries n x ^ (m - 2)) • basis.repr x, (y)⟫_ℝ = η x * (m * (⟪basis.repr x, y⟫_ℝ * (normPowerSeries n x) ^ (m - 2))) := by - simp [inner_smul_left] - ring_nf - left - trivial - conv => - enter [1, n, 2, x]; - rw [h1 n x] + rw [real_inner_smul_left] + ring + simp only [h1] apply MeasureTheory.tendsto_integral_of_dominated_convergence (bound := fun x => |η x| * |m| * |⟪basis.repr x, y⟫_ℝ| * ((‖x‖ + 1) ^ (m - 2) + ‖x‖ ^ (m - 2))) · intro n apply IsDistBounded.aeStronglyMeasurable_schwartzMap_smul (F := ℝ) ?_ η apply IsDistBounded.const_mul_fun simp [basis_repr_inner_eq] - apply IsDistBounded.isDistBounded_mul_inner' - fun_prop + exact IsDistBounded.isDistBounded_mul_inner' (by fun_prop) _ · have h1 : Integrable (fun x => η x * (m * (⟪basis.repr x, y⟫_ℝ * ((‖x‖ + 1) ^ (m - 2) + ‖x‖ ^ (m - 2))))) volume := by apply IsDistBounded.integrable_space_mul ?_ η @@ -643,21 +485,16 @@ lemma gradient_dist_normPowerSeries_zpow_tendsTo {d : ℕ} [NeZero d] (m : ℤ) simp [mul_add] apply IsDistBounded.add · simp [basis_repr_inner_eq] - apply IsDistBounded.isDistBounded_mul_inner' - refine IsDistBounded.norm_add_pos_nat_zpow (m - 2) 1 ?_ - simp + exact IsDistBounded.isDistBounded_mul_inner' + (IsDistBounded.norm_add_pos_nat_zpow (m - 2) 1 one_pos) _ · simp [basis_repr_inner_eq] conv => enter [1, x] rw [real_inner_comm] apply IsDistBounded.isDistBounded_mul_inner_of_smul_norm · apply IsDistBounded.mono (f := fun x => ‖x‖ ^ (m - 1) + 1) - · apply IsDistBounded.add - · apply IsDistBounded.pow (m - 1) - omega - · fun_prop - · apply AEMeasurable.aestronglyMeasurable - fun_prop + · exact (IsDistBounded.pow (m - 1) (by omega)).add (by fun_prop) + · exact AEMeasurable.aestronglyMeasurable (by fun_prop) · intro x simp only [norm_mul, Real.norm_eq_abs, abs_norm, norm_zpow] rw [abs_of_nonneg (by positivity)] @@ -665,60 +502,27 @@ lemma gradient_dist_normPowerSeries_zpow_tendsTo {d : ℕ} [NeZero d] (m : ℤ) · subst hx simp [zero_zpow_eq] split_ifs <;> grind - · trans ‖x‖ ^ (m - 1); swap - · simp - apply le_of_eq - trans ‖x‖ ^ (m - 2 + 1) - rw [zpow_add₀, zpow_one] - ring - simpa using hx - ring_nf - · apply AEMeasurable.aestronglyMeasurable - fun_prop - rw [← integrable_norm_iff] at h1 - convert h1 using 1 - funext x - simp [mul_assoc] - rw [abs_of_nonneg (by positivity)] - simp only [true_or] - fun_prop + · rw [mul_comm, ← zpow_add_one₀ (norm_ne_zero_iff.mpr hx), + show m - 2 + 1 = m - 1 by ring] + simp + · exact AEMeasurable.aestronglyMeasurable (by fun_prop) + refine h1.abs.congr (ae_of_all _ fun x => ?_) + simp only [abs_mul, mul_assoc, Int.cast_abs, + abs_of_nonneg (show (0:ℝ) ≤ (‖x‖ + 1) ^ (m - 2) + ‖x‖ ^ (m - 2) by positivity)] · intro n - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp at hx + filter_upwards [Measure.ae_ne volume 0] with x hx simp [mul_assoc] - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + gcongr rw [abs_of_nonneg (by simp)] exact normPowerSeries_zpow_le_norm_sq_add_one n (m - 2) x hx - · rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - simp [inner_smul_left, mul_assoc] - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - ring_nf - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - have h1 : Filter.Tendsto (fun x_1 => normPowerSeries x_1 x ^ ((m - 2 : ℤ) : ℝ)) - Filter.atTop (𝓝 (‖x‖ ^ ((m - 2 : ℤ) : ℝ))) := by - refine Filter.Tendsto.rpow ?_ ?_ ?_ - · apply normPowerSeries_tendsto x hx - · simp - · left - simpa using hx - simp [-Int.cast_sub, Real.rpow_intCast] at h1 - convert h1 using 3 - · ring - · ring + · filter_upwards [Measure.ae_ne volume 0] with x hx + have h2 : ⟪((m : ℝ) * ‖x‖ ^ (m - 2)) • basis.repr x, y⟫_ℝ = + (m : ℝ) * (⟪basis.repr x, y⟫_ℝ * ‖x‖ ^ (m - 2)) := by + rw [real_inner_smul_left] + ring + rw [h2] + exact tendsto_const_nhds.mul (tendsto_const_nhds.mul (tendsto_const_nhds.mul + ((normPowerSeries_tendsto x hx).zpow₀ _ (.inl (norm_ne_zero_iff.mpr hx))))) /-! @@ -731,8 +535,7 @@ lemma gradient_dist_normPowerSeries_log {d : ℕ} {n : ℕ} : distOfFunction (fun x : Space d => ((normPowerSeries n x) ^ (- 2 : ℤ)) • basis.repr x) (by fun_prop) := by ext1 η - apply ext_inner_right ℝ - intro y + refine ext_inner_right ℝ fun y => ?_ simp [distGrad_inner_eq] rw [Distribution.fderivD_apply, distOfFunction_apply, distOfFunction_inner] calc _ @@ -743,23 +546,18 @@ lemma gradient_dist_normPowerSeries_log {d : ℕ} {n : ℕ} : rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] · fun_prop · refine IsDistBounded.integrable_space_mul ?_ η - conv => enter [1, x]; rw [fderiv_log_normPowerSeries] + simp only [fderiv_log_normPowerSeries] fun_prop · fun_prop · fun_prop - · intro _ _ - apply Differentiable.differentiableAt - fun_prop + · exact fun _ _ => Differentiable.differentiableAt (by fun_prop) _ = ∫ (x : Space d), η x * (⟪basis.repr.symm y, x⟫_ℝ * (normPowerSeries n x) ^ (- 2 : ℤ)) := by - congr - funext x - rw [fderiv_log_normPowerSeries] + simp only [fderiv_log_normPowerSeries] congr funext x simp [inner_smul_left_eq_smul] left - rw [real_inner_comm] - rw [basis_repr_inner_eq] + rw [real_inner_comm, basis_repr_inner_eq] ring /-! @@ -785,41 +583,22 @@ lemma gradient_dist_normPowerSeries_log_tendsTo_distGrad_norm {d : ℕ} (hd : 2 apply MeasureTheory.tendsto_integral_of_dominated_convergence (bound := fun x => |fderiv ℝ η x (basis.repr.symm y)| * (‖x‖⁻¹ + (‖x‖ + 1))) · intro n - apply IsDistBounded.aeStronglyMeasurable_fderiv_schwartzMap_smul (F := ℝ) ?_ - fun_prop + exact IsDistBounded.aeStronglyMeasurable_fderiv_schwartzMap_smul (F := ℝ) (by fun_prop) η _ · have h1 : Integrable (fun x => (fderiv ℝ (⇑η) x) (basis.repr.symm y) * (‖x‖⁻¹ + (‖x‖ + 1))) volume := by - apply IsDistBounded.integrable_space_fderiv ?_ - apply IsDistBounded.add - · exact IsDistBounded.inv - · fun_prop - rw [← integrable_norm_iff] at h1 - convert h1 using 1 - funext x - simp only [norm_mul, Real.norm_eq_abs, mul_eq_mul_left_iff, abs_eq_zero] - left - rw [abs_of_nonneg (by positivity)] - fun_prop + apply IsDistBounded.integrable_space_fderiv + (IsDistBounded.add IsDistBounded.inv (by fun_prop)) + refine h1.abs.congr (ae_of_all _ fun x => ?_) + simp only [abs_mul] + congr 1 + exact abs_of_nonneg (by positivity) · intro n - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp at hx - simp - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) - exact normPowerSeries_log_le n x hx - · rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - apply Filter.Tendsto.log - · exact normPowerSeries_tendsto x hx - · simpa using hx + filter_upwards [Measure.ae_ne volume 0] with x hx + simp only [norm_mul, Real.norm_eq_abs] + exact mul_le_mul_of_nonneg_left (normPowerSeries_log_le n x hx) (abs_nonneg _) + · filter_upwards [Measure.ae_ne volume 0] with x hx + exact tendsto_const_nhds.mul + ((normPowerSeries_tendsto x hx).log (norm_ne_zero_iff.mpr hx)) lemma gradient_dist_normPowerSeries_log_tendsTo {d : ℕ} (hd : 2 ≤ d) (η : 𝓢(Space d, ℝ)) (y : EuclideanSpace ℝ (Fin d)) : @@ -831,78 +610,48 @@ lemma gradient_dist_normPowerSeries_log_tendsTo {d : ℕ} (hd : 2 ≤ d) refine (IsDistBounded.zpow_smul_repr_self _ ?_) omega) η, y⟫_ℝ)) := by haveI : NeZero d := ⟨by omega⟩ - conv => - enter [1, n]; - rw [gradient_dist_normPowerSeries_log] - simp only [distOfFunction_inner] + simp only [gradient_dist_normPowerSeries_log, distOfFunction_inner] have h1 (n : ℕ) (x : Space d) : η x * ⟪(normPowerSeries n x ^ (- 2 : ℤ)) • basis.repr x, y⟫_ℝ = η x * ((⟪basis.repr x, y⟫_ℝ * (normPowerSeries n x) ^ (- 2 : ℤ))) := by - simp [inner_smul_left] - ring_nf - left - trivial - conv => - enter [1, n, 2, x] - rw [h1 n x] + rw [real_inner_smul_left] + ring + simp only [h1] apply MeasureTheory.tendsto_integral_of_dominated_convergence (bound := fun x => |η x| * |⟪basis.repr x, y⟫_ℝ| * ((‖x‖ + 1) ^ (- 2 : ℤ) + ‖x‖ ^ (- 2 : ℤ))) · intro n - apply IsDistBounded.aeStronglyMeasurable_schwartzMap_smul (F := ℝ) ?_ η + refine IsDistBounded.aeStronglyMeasurable_schwartzMap_smul (F := ℝ) ?_ η simp only [basis_repr_inner_eq] - apply IsDistBounded.isDistBounded_mul_inner' - fun_prop + exact IsDistBounded.isDistBounded_mul_inner' (by fun_prop) _ · have h1 : Integrable (fun x => η x * ((⟪basis.repr x, y⟫_ℝ * ((‖x‖ + 1) ^ (- 2 : ℤ) + ‖x‖ ^ (- 2 : ℤ))))) volume := by apply IsDistBounded.integrable_space_mul ?_ η simp [mul_add] apply IsDistBounded.add · simp only [basis_repr_inner_eq] - apply IsDistBounded.isDistBounded_mul_inner' - refine IsDistBounded.norm_add_pos_nat_zpow (- 2) 1 ?_ - simp + exact IsDistBounded.isDistBounded_mul_inner' + (IsDistBounded.norm_add_pos_nat_zpow (- 2) 1 one_pos) _ · simp only [basis_repr_inner_eq] convert IsDistBounded.mul_inner_pow_neg_two (basis.repr.symm y) using 1 funext x simp [real_inner_comm] - rw [← integrable_norm_iff] at h1 - convert h1 using 1 - funext x - simp [mul_assoc] - rw [abs_of_nonneg (by positivity)] - simp only [true_or] - fun_prop + refine h1.abs.congr (ae_of_all _ fun x => ?_) + simp only [abs_mul, mul_assoc, + abs_of_nonneg (show (0:ℝ) ≤ (‖x‖ + 1) ^ (- 2 : ℤ) + ‖x‖ ^ (- 2 : ℤ) by positivity)] · intro n - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp at hx + filter_upwards [Measure.ae_ne volume 0] with x hx simp [mul_assoc] - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) - apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + gcongr rw [abs_of_nonneg (by simp)] exact normPowerSeries_zpow_le_norm_sq_add_one n (- 2 : ℤ) x hx - · rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - simp [inner_smul_left, inner_smul_left] - rw [mul_comm] - apply Filter.Tendsto.mul - · exact tendsto_const_nhds - have h1 : Filter.Tendsto (fun x_1 => normPowerSeries x_1 x ^ ((- 2 : ℤ) : ℝ)) - Filter.atTop (𝓝 (‖x‖ ^ ((- 2 : ℤ) : ℝ))) := by - refine Filter.Tendsto.rpow ?_ ?_ ?_ - · apply normPowerSeries_tendsto x hx - · simp - · left - simpa using hx - simpa using h1 + · filter_upwards [Measure.ae_ne volume 0] with x hx + have h2 : ⟪(‖x‖ ^ (- 2 : ℤ)) • basis.repr x, y⟫_ℝ = + ⟪basis.repr x, y⟫_ℝ * ‖x‖ ^ (- 2 : ℤ) := by + rw [real_inner_smul_left] + ring + rw [h2] + exact tendsto_const_nhds.mul (tendsto_const_nhds.mul + ((normPowerSeries_tendsto x hx).zpow₀ _ (.inl (norm_ne_zero_iff.mpr hx)))) /-! @@ -957,9 +706,8 @@ open Distribution private lemma integrable_real_pow_mul_schwartz (ψ : 𝓢(ℝ, ℝ)) (k : ℕ) : Integrable (fun x : ℝ => x ^ k * ψ x) volume := by - refine (ψ.integrable_pow_mul volume k).mono' (by fun_prop) ?_ - filter_upwards with x - simp [norm_mul, norm_pow] + refine (ψ.integrable_pow_mul volume k).mono' (by fun_prop) + (ae_of_all _ fun x => by simp [norm_mul, norm_pow]) private lemma radial_power_deriv_integral_by_parts {d : ℕ} (η : 𝓢(Space d, ℝ)) @@ -983,9 +731,7 @@ private lemma radial_power_deriv_integral_by_parts | 1 => use 0, 1 intro x - simp [fderiv_smul_const, iteratedFDeriv_succ_eq_comp_right] - rw [(continuousMultilinearCurryRightEquiv' ℝ 0 ℝ (Space d)).symm.norm_map] - simp [ContinuousLinearMap.norm_smulRight_apply] + simp [fderiv_smul_const] | n' + 1 + 1 => use 0, 0 intro x @@ -1002,36 +748,29 @@ private lemma radial_power_deriv_integral_by_parts ∀ k x, ((Physlib.Distribution.powOneMul ℝ)^[k] η') x = x ^ k * η' x := by intro k induction k with - | zero => - intro x - simp + | zero => simp | succ k ih => - intro x - rw [Function.iterate_succ_apply'] - rw [Physlib.Distribution.powOneMul_apply, ih] - rw [pow_succ] - change x * (x ^ k * η' x) = x ^ k * x * η' x - ring + intro x + rw [Function.iterate_succ_apply', Physlib.Distribution.powOneMul_apply, ih, pow_succ] + change x * (x ^ k * η' x) = x ^ k * x * η' x + ring have hleft_subtype : ∫ (r : Set.Ioi (0 : ℝ)), r.1 ^ p * _root_.deriv (fun a => η (a • n.1)) r.1 ∂(.comap Subtype.val volume) = ∫ (x : ℝ) in Set.Ioi (0 : ℝ), - x ^ p * _root_.deriv (fun a => η (a • n.1)) x := by - exact MeasureTheory.integral_subtype_comap (μ := volume) - (s := Set.Ioi (0 : ℝ)) measurableSet_Ioi - (fun x : ℝ => x ^ p * _root_.deriv (fun a => η (a • n.1)) x) + x ^ p * _root_.deriv (fun a => η (a • n.1)) x := + MeasureTheory.integral_subtype_comap measurableSet_Ioi + fun x : ℝ => x ^ p * _root_.deriv (fun a => η (a • n.1)) x have hright_subtype : ∫ (r : Set.Ioi (0 : ℝ)), r.1 ^ (p - 1) * η (r.1 • n.1) ∂(.comap Subtype.val volume) = ∫ (x : ℝ) in Set.Ioi (0 : ℝ), - x ^ (p - 1) * η (x • n.1) := by - exact MeasureTheory.integral_subtype_comap (μ := volume) - (s := Set.Ioi (0 : ℝ)) measurableSet_Ioi - (fun x : ℝ => x ^ (p - 1) * η (x • n.1)) + x ^ (p - 1) * η (x • n.1) := + MeasureTheory.integral_subtype_comap measurableSet_Ioi fun x : ℝ => x ^ (p - 1) * η (x • n.1) rw [hleft_subtype, hright_subtype] have hIBP : ∫ (x : ℝ) in Set.Ioi (0 : ℝ), @@ -1047,51 +786,26 @@ private lemma radial_power_deriv_integral_by_parts (v := fun x : ℝ => η (x • n.1)) (v' := fun x : ℝ => _root_.deriv (fun a => η (a • n.1)) x) (a' := (0 : ℝ)) (b' := (0 : ℝ)) ?_ ?_ ?_ ?_ ?_ ?_ - · intro x hx - simpa using (hasDerivAt_pow p x) - · intro x hx - exact DifferentiableAt.hasDerivAt (by fun_prop : - DifferentiableAt ℝ (fun x : ℝ => η (x • n.1)) x) - · have hderiv_int : - Integrable (fun x : ℝ => - x ^ p * ((SchwartzMap.derivCLM ℝ ℝ) η') x) volume := - integrable_real_pow_mul_schwartz ((SchwartzMap.derivCLM ℝ ℝ) η') p - exact hderiv_int.integrableOn.congr_fun (by - intro x hx - have hderiv_eq : - _root_.deriv η' x = _root_.deriv (fun a => η (a • n.1)) x := by - congr 1 - simp [SchwartzMap.derivCLM_apply, hderiv_eq]) - measurableSet_Ioi - · have hbase : - Integrable (fun x : ℝ => x ^ (p - 1) * η' x) volume := - integrable_real_pow_mul_schwartz η' (p - 1) - have hconst : - Integrable (fun x : ℝ => (p : ℝ) * (x ^ (p - 1) * η' x)) volume := - hbase.const_mul (p : ℝ) - exact hconst.integrableOn.congr_fun (by - intro x hx - ring_nf - simp [hη'_apply, mul_assoc]) - measurableSet_Ioi - · have hcont : - ContinuousAt (fun x : ℝ => x ^ p * η (x • n.1)) (0 : ℝ) := by - fun_prop - have hlim := tendsto_nhdsWithin_of_tendsto_nhds - (s := Set.Ioi (0 : ℝ)) hcont.tendsto + · exact fun x _ => by simpa using hasDerivAt_pow p x + · exact fun x _ => DifferentiableAt.hasDerivAt (by fun_prop) + · refine (integrable_real_pow_mul_schwartz ((SchwartzMap.derivCLM ℝ ℝ) η') + p).integrableOn.congr_fun (fun x _ => ?_) measurableSet_Ioi + have hderiv_eq : _root_.deriv η' x = _root_.deriv (fun a => η (a • n.1)) x := by congr 1 + simp [SchwartzMap.derivCLM_apply, hderiv_eq] + · refine ((integrable_real_pow_mul_schwartz η' (p - 1)).const_mul + (p : ℝ)).integrableOn.congr_fun (fun x _ => ?_) measurableSet_Ioi + ring_nf + simp [hη'_apply, mul_assoc] + · have hcont : ContinuousAt (fun x : ℝ => x ^ p * η (x • n.1)) (0 : ℝ) := by fun_prop + have hlim := tendsto_nhdsWithin_of_tendsto_nhds (s := Set.Ioi (0 : ℝ)) hcont.tendsto simp only [ne_eq, hp.ne', not_false_eq_true, zero_pow, zero_smul, zero_mul] at hlim exact hlim - · have hzero : - Filter.Tendsto (fun x : ℝ => x ^ p * η' x) Filter.atTop (𝓝 (0 : ℝ)) := by - have hsch : - Filter.Tendsto (fun x : ℝ => ((Physlib.Distribution.powOneMul ℝ)^[p] η') x) - Filter.atTop (𝓝 (0 : ℝ)) := - Filter.Tendsto.mono_left - (((Physlib.Distribution.powOneMul ℝ)^[p] η').toZeroAtInfty.zero_at_infty') - atTop_le_cocompact - exact hsch.congr' (Filter.Eventually.of_forall (fun x => by - rw [hmul_iter_apply p x])) - exact hzero + · have hsch : Filter.Tendsto (fun x : ℝ => ((Physlib.Distribution.powOneMul ℝ)^[p] η') x) + Filter.atTop (𝓝 (0 : ℝ)) := + Filter.Tendsto.mono_left + (((Physlib.Distribution.powOneMul ℝ)^[p] η').toZeroAtInfty.zero_at_infty') + atTop_le_cocompact + exact hsch.congr' (Filter.Eventually.of_forall (hmul_iter_apply p)) calc -∫ (x : ℝ) in Set.Ioi (0 : ℝ), x ^ p * _root_.deriv (fun a => η (a • n.1)) x @@ -1101,10 +815,7 @@ private lemma radial_power_deriv_integral_by_parts ring _ = (p : ℝ) * ∫ (x : ℝ) in Set.Ioi (0 : ℝ), x ^ (p - 1) * η (x • n.1) := by - rw [← integral_const_mul] - congr - funext x - ring + simp only [mul_assoc, integral_const_mul] private lemma distDiv_norm_zpow_smul_repr_self_apply_eq_radial_deriv {d p : ℕ} [NeZero d] (q : ℤ) (hq : 0 < q + (d : ℤ)) @@ -1148,10 +859,8 @@ private lemma distDiv_norm_zpow_smul_repr_self_apply_eq_radial_deriv rw [NNReal.smul_def] rw [Real.coe_toNNReal _ (pow_nonneg (le_of_lt hr) (d - 1))] · simp only [smul_eq_mul] - rw [hnorm] - rw [← grad_smul_inner_space (n : Space d) (⇑η) - (SchwartzMap.differentiable η) (r : ℝ) hr] - rw [real_inner_comm] + rw [hnorm, ← grad_smul_inner_space (n : Space d) (⇑η) + (SchwartzMap.differentiable η) (r : ℝ) hr, real_inner_comm] simp only [inner_smul_right] rw [← radial_jacobian_zpow_mul_self hp_int hr] ring @@ -1165,14 +874,8 @@ lemma distDiv_norm_zpow_smul_repr_self_eq_smul (IsDistBounded.pow q (by omega))) := by ext η let p : ℕ := Int.toNat (q + (d : ℤ)) - have hp_int : (p : ℤ) = q + (d : ℤ) := by - dsimp [p] - exact Int.toNat_of_nonneg (le_of_lt hq) - have hp_pos : 0 < p := by - have : (0 : ℤ) < (p : ℤ) := by - rw [hp_int] - exact hq - exact_mod_cast this + have hp_int : (p : ℤ) = q + (d : ℤ) := by simpa [p] using Int.toNat_of_nonneg (le_of_lt hq) + have hp_pos : 0 < p := by omega have hcoef : (((q + d : ℤ) : ℝ)) = (p : ℝ) := by exact_mod_cast hp_int.symm calc @@ -1202,10 +905,7 @@ lemma distDiv_norm_zpow_smul_repr_self_eq_smul _ = (((q + (d : ℤ) : ℤ) : ℝ) • distOfFunction (fun x : Space d => ‖x‖ ^ q) (IsDistBounded.pow q (by omega))) η := by - simp [distOfFunction_apply, mul_comm] - left - rw [← hcoef] - norm_num + simp [distOfFunction_apply, hcoef] /-! @@ -1220,10 +920,7 @@ lemma distLaplacian_distOfFunction_norm_zpow {d : ℕ} [NeZero d] (m : ℤ) (((m : ℝ) * (((m - 2 + d : ℤ) : ℝ))) • distOfFunction (fun x : Space d => ‖x‖ ^ (m - 2)) (IsDistBounded.pow (m - 2) (by omega))) := by - rw [distLaplacian] - change ∇ᵈ ⬝ (∇ᵈ (distOfFunction (fun x : Space d => ‖x‖ ^ m) - (IsDistBounded.pow m (by omega)))) = _ - rw [distGrad_distOfFunction_norm_zpow m (by omega)] + rw [distLaplacian, LinearMap.comp_apply, distGrad_distOfFunction_norm_zpow m (by omega)] have hdist : distOfFunction (fun x : Space d => (m * ‖x‖ ^ (m - 2)) • basis.repr x) (by @@ -1239,10 +936,7 @@ lemma distLaplacian_distOfFunction_norm_zpow {d : ℕ} [NeZero d] (m : ℤ) (IsDistBounded.zpow_smul_repr_self (m - 2) (by omega)) (m : ℝ) using 1 ext x simp [smul_smul] - rw [hdist] - rw [map_smul] - rw [distDiv_norm_zpow_smul_repr_self_eq_smul (m - 2) hdiv] - rw [smul_smul] + rw [hdist, map_smul, distDiv_norm_zpow_smul_repr_self_eq_smul (m - 2) hdiv, smul_smul] /-! @@ -1303,8 +997,7 @@ lemma distDiv_inv_pow_eq_dim {d : ℕ} [NeZero d] : simp only [Real.norm_eq_abs, inv_pow, Function.comp_apply, homeomorphUnitSphereProd_symm_apply_coe, map_smul] let x : Space d := r.2.1 • r.1.1 - have hr := r.2.2 - simp [-Subtype.coe_prop] at hr + have hr : (0 : ℝ) < r.2.1 := r.2.2 rw [abs_of_nonneg (le_of_lt hr)] trans (r.2.1 ^ (d - 1))⁻¹ * _root_.deriv (fun a => η (a • ‖↑x‖⁻¹ • ↑x)) ‖x‖ · simp [x, norm_smul] @@ -1332,8 +1025,7 @@ lemma distDiv_inv_pow_eq_dim {d : ℕ} [NeZero d] : erw [integral_withDensity_eq_integral_smul] congr funext r - have hr := r.2 - simp [-Subtype.coe_prop] at hr + have hr : (0 : ℝ) < r.1 := r.2 rw [abs_of_nonneg hr.le, NNReal.smul_def, Real.coe_toNNReal _ (by positivity), smul_eq_mul, ← mul_assoc, mul_inv_cancel₀ (pow_ne_zero (d - 1) hr.ne'), one_mul] fun_prop @@ -1365,12 +1057,8 @@ lemma distDiv_inv_pow_eq_dim {d : ℕ} [NeZero d] : rw [MeasureTheory.integral_subtype_comap (by simp), MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto (f := fun a => η (a • n)) (m := 0)] · simp - · refine ContinuousAt.continuousWithinAt ?_ - fun_prop - · intro x hx - refine DifferentiableAt.hasDerivAt ?_ - have := η.differentiable - fun_prop + · exact ContinuousAt.continuousWithinAt (by fun_prop) + · exact fun x _ => DifferentiableAt.hasDerivAt (by fun_prop) · exact (integrable ((derivCLM ℝ ℝ) (η' n))).integrableOn · exact Filter.Tendsto.mono_left (η' n).toZeroAtInfty.zero_at_infty' atTop_le_cocompact _ = η 0 * (d * (volume (α := Space d)).real (Metric.ball 0 1)) := by @@ -1406,9 +1094,7 @@ lemma distLaplacian_fundamentalSolution_norm_zpow {d : ℕ} : rw [distOfFunction_apply] refine integral_eq_zero_of_ae (ae_of_all _ fun x => ?_) rw [Subsingleton.elim x 0] - simp only [norm_zero, smul_eq_mul, Pi.zero_apply, mul_eq_zero] - right - linarith + simp [zero_zpow_eq] simp [hzero] · haveI : NeZero d := ⟨by omega⟩ rw [distLaplacian] @@ -1438,18 +1124,7 @@ lemma distLaplacian_fundamentalSolution_norm_zpow {d : ℕ} : (2 - (d : ℝ)) using 1 ext x simp [smul_smul] - rw [hdist] - rw [map_smul] - have hdiv : - ∇ᵈ ⬝ (distOfFunction - (fun x : Space d => - ‖x‖ ^ (- (d : ℤ)) • basis.repr x) - (IsDistBounded.zpow_smul_repr_self (- (d : ℤ)) (by omega))) = - (d * (volume (α := Space d)).real - (Metric.ball 0 1)) • diracDelta ℝ 0 := by - exact distDiv_inv_pow_eq_dim (d := d) - rw [hdiv] - rw [smul_smul] + rw [hdist, map_smul, distDiv_inv_pow_eq_dim, smul_smul] ring_nf /-- In dimension two the fundamental solution of the Laplacian is the logarithm: the diff --git a/Physlib/SpaceAndTime/SpaceTime/Basic.lean b/Physlib/SpaceAndTime/SpaceTime/Basic.lean index 3852a03a7..b2a4112cf 100644 --- a/Physlib/SpaceAndTime/SpaceTime/Basic.lean +++ b/Physlib/SpaceAndTime/SpaceTime/Basic.lean @@ -301,22 +301,18 @@ def toTimeAndSpace {d : ℕ} (c : SpeedOfLight := 1) : SpaceTime d ≃L[ℝ] Tim @[simp] lemma toTimeAndSpace_symm_apply_time_space {d : ℕ} {c : SpeedOfLight} (x : SpaceTime d) : - (toTimeAndSpace c).symm (x.time c, x.space) = x := by - apply (toTimeAndSpace c).left_inv + (toTimeAndSpace c).symm (x.time c, x.space) = x := + (toTimeAndSpace c).left_inv x @[simp] lemma space_toTimeAndSpace_symm {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : ((toTimeAndSpace c).symm (t, s)).space = s := by - simp only [space, toTimeAndSpace] - ext i - simp + simp [space, toTimeAndSpace] @[simp] lemma time_toTimeAndSpace_symm {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : ((toTimeAndSpace c).symm (t, s)).time c = t := by - simp only [time, toTimeAndSpace] - ext - simp + simp [time, toTimeAndSpace] @[simp] lemma toTimeAndSpace_symm_apply_inl {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : @@ -356,13 +352,10 @@ lemma toTimeAndSpace_symm_fderiv {d : ℕ} {c : SpeedOfLight} (x : Time × Space lemma toTimeAndSpace_basis_inr {d : ℕ} {c : SpeedOfLight} (i : Fin d) : toTimeAndSpace c (Lorentz.Vector.basis (Sum.inr i)) = (0, Space.basis i) := by - simp only [toTimeAndSpace, time, LinearMap.coe_mk, - AddHom.coe_mk, LinearEquiv.coe_toContinuousLinearEquiv', LinearEquiv.coe_mk, Prod.mk.injEq] - rw [Lorentz.Vector.timeComponent_basis_sum_inr] - constructor - · simp - ext j - simp [Space.basis_apply, space] + refine Prod.ext ?_ ?_ + · simp [toTimeAndSpace, time] + · ext j + simp [toTimeAndSpace, space, Space.basis_apply] /-! @@ -372,20 +365,15 @@ lemma toTimeAndSpace_basis_inr {d : ℕ} {c : SpeedOfLight} (i : Fin d) : lemma toTimeAndSpace_basis_inl {d : ℕ} {c : SpeedOfLight} : toTimeAndSpace (d := d) c (Lorentz.Vector.basis (Sum.inl 0)) = (⟨1/c.val⟩, 0) := by - simp only [toTimeAndSpace, time, LinearMap.coe_mk, - AddHom.coe_mk, LinearEquiv.coe_toContinuousLinearEquiv', LinearEquiv.coe_mk, Prod.mk.injEq] - rw [Lorentz.Vector.timeComponent_basis_sum_inl] - constructor - · simp - ext j - simp [space] + refine Prod.ext ?_ ?_ + · simp [toTimeAndSpace, time] + · ext j + simp [toTimeAndSpace, space] lemma toTimeAndSpace_basis_inl' {d : ℕ} {c : SpeedOfLight} : toTimeAndSpace (d := d) c (Lorentz.Vector.basis (Sum.inl 0)) = (1/c.val) • (1, 0) := by rw [toTimeAndSpace_basis_inl] - simp only [one_div, Prod.smul_mk, smul_zero, Prod.mk.injEq, and_true] - congr - simp + simp [Prod.ext_iff, Time.ext_iff, Time.smul_real_val, Time.one_val] /-! @@ -411,19 +399,15 @@ lemma timeSpaceBasis_apply_inl {d : ℕ} (c : SpeedOfLight) : timeSpaceBasis (d := d) c (Sum.inl 0) = c.val • Lorentz.Vector.basis (Sum.inl 0) := by simp [timeSpaceBasis] apply (toTimeAndSpace (d := d) c).injective - simp only [ContinuousLinearEquiv.apply_symm_apply, Fin.isValue, map_smul] - rw [@toTimeAndSpace_basis_inl] - simp only [one_div, Prod.smul_mk, smul_zero, Prod.mk.injEq, and_true] - ext - simp + simp only [ContinuousLinearEquiv.apply_symm_apply, map_smul, toTimeAndSpace_basis_inl] + ext <;> simp @[simp] lemma timeSpaceBasis_apply_inr {d : ℕ} (c : SpeedOfLight) (i : Fin d) : timeSpaceBasis (d := d) c (Sum.inr i) = Lorentz.Vector.basis (Sum.inr i) := by simp [timeSpaceBasis] apply (toTimeAndSpace (d := d) c).injective - simp only [ContinuousLinearEquiv.apply_symm_apply] - rw [toTimeAndSpace_basis_inr] + simp only [ContinuousLinearEquiv.apply_symm_apply, toTimeAndSpace_basis_inr] /-! @@ -510,16 +494,8 @@ lemma det_timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : · simp only [ContinuousLinearEquiv.toLinearEquiv_symm, LinearMap.det_conj] have h1 : e.toLinearMap ∘ₗ (timeSpaceBasisEquiv (d := d) c).toLinearMap ∘ₗ e.symm.toLinearMap = (c.val • LinearMap.id).prodMap LinearMap.id := by - apply LinearMap.ext - intro tx - simp [e, timeSpaceBasisEquiv, toTimeAndSpace] - apply And.intro - · ext - simp - · ext i - simp [space] - rw [h1] - rw [LinearMap.det_prodMap] + ext tx <;> simp [e, timeSpaceBasisEquiv, toTimeAndSpace, space] + rw [h1, LinearMap.det_prodMap] simp /-! @@ -536,15 +512,11 @@ lemma timeSpaceBasis_eq_map_basis {d : ℕ} (c : SpeedOfLight) : | Sum.inl 0 => simp [timeSpaceBasisEquiv] funext ν - match ν with - | Sum.inl 0 => simp - | Sum.inr i => simp + rcases ν with _ | j <;> simp [Fin.fin_one_eq_zero] | Sum.inr i => simp [timeSpaceBasisEquiv] funext ν - match ν with - | Sum.inl 0 => simp - | Sum.inr j => simp + rcases ν with _ | j <;> simp [Fin.fin_one_eq_zero] /-! @@ -579,12 +551,10 @@ open MeasureTheory lemma toTimeAndSpace_symm_measurePreserving {d : ℕ} (c : SpeedOfLight) : MeasurePreserving (toTimeAndSpace c).symm (volume.prod (volume (α := Space d))) (ENNReal.ofReal c⁻¹ • volume) := by - have h : volume (α := SpaceTime d) = Lorentz.Vector.basis.addHaar := rfl refine { measurable := ?_, map_eq := ?_ } · fun_prop rw [Space.volume_eq_addHaar, Time.volume_eq_basis_addHaar, ← Module.Basis.prod_addHaar, - Module.Basis.map_addHaar] - rw [← timeSpaceBasis_addHaar c] + Module.Basis.map_addHaar, ← timeSpaceBasis_addHaar c] rfl /-! @@ -602,20 +572,8 @@ lemma spaceTime_integral_eq_time_space_integral {M} [NormedAddCommGroup M] have h1 : ∫ tx : Time × Space d, f ((toTimeAndSpace c).symm tx) ∂(volume.prod volume) = ∫ x : SpaceTime d, f x ∂((ENNReal.ofReal (c⁻¹)) • volume) := by apply MeasureTheory.MeasurePreserving.integral_comp - · refine { measurable := ?_, map_eq := ?_ } - · fun_prop - have hs : volume (α := Space d) = Space.basis.toBasis.addHaar := by - exact Space.volume_eq_addHaar - have ht : volume (α := Time) = Time.basis.toBasis.addHaar := by - exact Time.volume_eq_basis_addHaar - rw [hs, ht] - rw [← Module.Basis.prod_addHaar] - rw [Module.Basis.map_addHaar] - rw [← timeSpaceBasis_addHaar c] - congr - · refine Measurable.measurableEmbedding ?_ ?_ - · fun_prop - · exact ContinuousLinearEquiv.injective (toTimeAndSpace c).symm + · exact toTimeAndSpace_symm_measurePreserving c + · exact (toTimeAndSpace c).symm.toHomeomorph.measurableEmbedding rw [h1] simp @@ -630,9 +588,7 @@ lemma spaceTime_integrable_iff_space_time_integrable {M} [NormedAddCommGroup M] · simp apply MeasureTheory.MeasurePreserving.integrable_comp_emb · exact toTimeAndSpace_symm_measurePreserving c - · refine Measurable.measurableEmbedding ?_ ?_ - · fun_prop - · exact ContinuousLinearEquiv.injective (toTimeAndSpace c).symm + · exact (toTimeAndSpace c).symm.toHomeomorph.measurableEmbedding lemma spaceTime_integral_eq_time_integral_space_integral {M} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} (c : SpeedOfLight) @@ -641,8 +597,7 @@ lemma spaceTime_integral_eq_time_integral_space_integral {M} [NormedAddCommGroup ∫ x : SpaceTime d, f x = c.val • ∫ t : Time, ∫ x : Space d, f ((toTimeAndSpace c).symm (t, x)) := by rw [spaceTime_integral_eq_time_space_integral, MeasureTheory.integral_prod] - rw [spaceTime_integrable_iff_space_time_integrable] at h - exact h + exact (spaceTime_integrable_iff_space_time_integrable c f).mp h lemma spaceTime_integral_eq_space_integral_time_integral {M} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} (c : SpeedOfLight) @@ -651,8 +606,7 @@ lemma spaceTime_integral_eq_space_integral_time_integral {M} [NormedAddCommGroup ∫ x : SpaceTime d, f x = c.val • ∫ x : Space d, ∫ t : Time, f ((toTimeAndSpace c).symm (t, x)) := by rw [spaceTime_integral_eq_time_space_integral, MeasureTheory.integral_prod_symm] - rw [spaceTime_integrable_iff_space_time_integrable] at h - exact h + exact (spaceTime_integrable_iff_space_time_integrable c f).mp h end SpaceTime diff --git a/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean b/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean index d7de1137f..9ced9ab31 100644 --- a/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean +++ b/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean @@ -139,44 +139,31 @@ variable {M : Type} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] lemma differentiable_vector {d : ℕ} (f : SpaceTime d → Lorentz.Vector d) : (∀ ν, Differentiable ℝ (fun x => f x ν)) ↔ Differentiable ℝ f := by - apply Iff.intro - · intro h - rw [← (Lorentz.Vector.equivPi d).comp_differentiable_iff] + refine ⟨fun h => ?_, fun h ν => ?_⟩ + · rw [← (Lorentz.Vector.equivPi d).comp_differentiable_iff] exact differentiable_pi'' h - · intro h ν - change Differentiable ℝ (Lorentz.Vector.coordCLM ν ∘ f) - apply Differentiable.comp - · fun_prop - · exact h + · exact (Lorentz.Vector.coordCLM ν).differentiable.comp h lemma contDiff_vector {d : ℕ} (f : SpaceTime d → Lorentz.Vector d) : (∀ ν, ContDiff ℝ n (fun x => f x ν)) ↔ ContDiff ℝ n f := by - apply Iff.intro - · intro h - rw [← (Lorentz.Vector.equivPi d).comp_contDiff_iff] - apply contDiff_pi' - intro ν - exact h ν - · intro h ν - change ContDiff ℝ n (Lorentz.Vector.coordCLM ν ∘ f) - apply ContDiff.comp - · fun_prop - · exact h + refine ⟨fun h => ?_, fun h ν => ?_⟩ + · rw [← (Lorentz.Vector.equivPi d).comp_contDiff_iff] + exact contDiff_pi' h + · exact (Lorentz.Vector.coordCLM ν).contDiff.comp h lemma fderiv_vector {d : ℕ} (f : SpaceTime d → Lorentz.Vector d) (hf : Differentiable ℝ f) (y dt : SpaceTime d) (ν : Fin 1 ⊕ Fin d) : fderiv ℝ f y dt ν = fderiv ℝ (fun x => f x ν) y dt := by change _ = (fderiv ℝ (Lorentz.Vector.coordCLM ν ∘ f) y) dt rw [fderiv_comp _ (by fun_prop) (by fun_prop)] - simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp, Function.comp_apply] - rfl + simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp, Function.comp_apply, + Lorentz.Vector.coordCLM_apply] lemma deriv_apply_eq {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) (f : SpaceTime d → Lorentz.Vector d) (hf : Differentiable ℝ f) (y : SpaceTime d) : - ∂_ μ f y ν = fderiv ℝ (fun x => f x ν) y (Lorentz.Vector.basis μ) := by - rw [deriv_eq] - exact fderiv_vector f hf y _ ν + ∂_ μ f y ν = fderiv ℝ (fun x => f x ν) y (Lorentz.Vector.basis μ) := + fderiv_vector f hf y _ ν @[simp] lemma deriv_coord {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : @@ -186,9 +173,7 @@ lemma deriv_coord {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : rw [deriv_eq] simp only [ContinuousLinearMap.fderiv] simp [coordCLM] - split_ifs - rfl - rfl + split_ifs <;> rfl /-! @@ -199,8 +184,7 @@ lemma deriv_coord {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : @[simp] lemma deriv_zero {d : ℕ} (μ : Fin 1 ⊕ Fin d) : SpaceTime.deriv μ (fun _ => (0 : ℝ)) = 0 := by ext y - rw [SpaceTime.deriv_eq] - simp + simp [SpaceTime.deriv_eq] attribute [-simp] Fintype.sum_sum_type @@ -217,7 +201,6 @@ lemma contDiff_deriv {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ContDiff ℝ n (∂_ μ f) := by -- `∂_ μ f = fun x => fderiv ℝ f x (Lorentz.Vector.basis μ)`; use -- `ContDiff.clm_apply` with `ContDiff.fderiv_right`. - show ContDiff ℝ n (fun x => fderiv ℝ f x (Lorentz.Vector.basis μ)) exact (ContDiff.fderiv_right (m := n) hf (by rfl)).clm_apply contDiff_const /-- If `f` is `C^2` then `∂_ μ f` is differentiable. -/ @@ -244,13 +227,8 @@ lemma deriv_commute {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, ContinuousLinearMap.flip_apply] rw [IsSymmSndFDerivAt.eq] - · apply ContDiffAt.isSymmSndFDerivAt - exact hf.contDiffAt - simp only [minSmoothness_of_isRCLikeNormedField, le_refl] - · have h1 := hf.differentiable (by norm_cast); fun_prop - · fun_prop - · have h1 := hf.differentiable (by norm_cast); fun_prop - · fun_prop + · exact hf.contDiffAt.isSymmSndFDerivAt (by simp [minSmoothness_of_isRCLikeNormedField]) + all_goals fun_prop /-! @@ -269,8 +247,7 @@ lemma deriv_comp_lorentz_action {M : Type} [NormedAddCommGroup M] [NormedSpace ContinuousLinearMap.coe_comp, Function.comp_apply] -- Fintype.sum_sum_type rw [Lorentz.Vector.smul_basis] - simp - rfl + simp [deriv_eq] · fun_prop · fun_prop @@ -285,17 +262,13 @@ lemma deriv_equivariant (f : SpaceTime d → M) (Λ : LorentzGroup d) (x : Space ∂_ μ (fun x => Λ • f (Λ⁻¹ • x)) x = Λ • ∂_ μ (fun x => f (Λ⁻¹ • x)) x := by change ∂_ μ (TensorSpecies.Tensorial.actionCLM _ Λ ∘ fun x => f (Λ⁻¹ • x)) x = _ - rw [deriv_eq] - rw [fderiv_comp] + rw [deriv_eq, fderiv_comp] simp [Tensorial.actionCLM_apply, ← deriv_eq] · fun_prop - · apply Differentiable.differentiableAt - have hx : Differentiable ℝ (f ∘ (Lorentz.Vector.actionCLM Λ⁻¹)) := by fun_prop - exact hx + · exact (hf.comp (Lorentz.Vector.actionCLM Λ⁻¹).differentiable).differentiableAt rw [h1 μ x, deriv_comp_lorentz_action] change (TensorSpecies.Tensorial.actionCLM _ Λ) (∑ ν, (Λ⁻¹).1 ν μ • ∂_ ν f (Λ⁻¹ • x)) = _ - simp only [map_sum, map_smul] - simp [TensorSpecies.Tensorial.actionCLM_apply] + simp [TensorSpecies.Tensorial.actionCLM_apply, map_sum, map_smul] · fun_prop /-! @@ -401,8 +374,7 @@ lemma apply_fderiv_eq_distDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] f ((SchwartzMap.evalCLM ℝ (SpaceTime d) ℝ (Lorentz.Vector.basis μ)) ((fderivCLM ℝ (SpaceTime d) ℝ) ε)) = - distDeriv μ f ε := by - rw [distDeriv_apply'] - simp + simp [distDeriv_apply'] /-! @@ -415,9 +387,7 @@ lemma distDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] (μ ν : Fin 1 ⊕ Fin d) (f : (SpaceTime d) →d[ℝ] M) : distDeriv μ (distDeriv ν f) = distDeriv ν (distDeriv μ f) := by ext κ - rw [distDeriv_apply, distDeriv_apply, fderivD_apply, fderivD_apply] - rw [distDeriv_apply, distDeriv_apply, fderivD_apply, fderivD_apply] - simp only [neg_neg] + simp only [distDeriv_apply, fderivD_apply, neg_neg] congr 1 ext x exact congrFun (deriv_commute ν μ ⇑κ (smooth κ 2)) x @@ -502,8 +472,7 @@ lemma tensorDeriv_equivariant (f : SpaceTime d → M) (Λ : LorentzGroup d) (x : enter [2, ν] rw [← sum_tmul, ← Lorentz.CoVector.smul_basis, ← Tensorial.smul_prod] change _ = (TensorSpecies.Tensorial.smulLinearMap Λ) _ - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, map_sum] - simp [TensorSpecies.Tensorial.smulLinearMap_apply] + simp [TensorSpecies.Tensorial.smulLinearMap_apply, map_sum] open TensorSpecies.Tensorial Lorentz Tensor @@ -532,8 +501,7 @@ lemma tensorDeriv_toTensor_basis_repr enter [2, x] rw [h1 x] conv_rhs => - rw [deriv_eq] - rw [fderiv_fun_comp _ (by fun_prop) (by fun_prop)] + rw [deriv_eq, fderiv_fun_comp _ (by fun_prop) (by fun_prop)] rw [ContinuousLinearMap.fderiv] simp [deriv_eq] · intro b' _ hb @@ -618,8 +586,7 @@ lemma distTensorDeriv_equivariant {M : Type} [NormedAddCommGroup M] simp only [Nat.succ_eq_add_one, Nat.reduceAdd, ContinuousLinearMap.coe_comp, ContinuousLinearMap.coe_coe, Function.comp_apply] rw [distTensorDeriv_apply] - simp only [map_sum] - simp [TensorSpecies.Tensorial.smulLinearMap_apply] + simp [TensorSpecies.Tensorial.smulLinearMap_apply, map_sum] lemma distTensorDeriv_toTensor_basis_repr {M : Type} [NormedAddCommGroup M] [InnerProductSpace ℝ M] [FiniteDimensional ℝ M] [(realLorentzTensor d).Tensorial c M] diff --git a/Physlib/SpaceAndTime/Time/Basic.lean b/Physlib/SpaceAndTime/Time/Basic.lean index 20e3fbe16..1bec924fd 100644 --- a/Physlib/SpaceAndTime/Time/Basic.lean +++ b/Physlib/SpaceAndTime/Time/Basic.lean @@ -80,10 +80,7 @@ structure Time where namespace Time -lemma val_injective : Function.Injective val := by - intro t1 t2 h - ext - exact h +lemma val_injective : Function.Injective val := fun _ _ h => Time.ext h /-! @@ -117,28 +114,20 @@ lemma natCast_one : ((1 : ℕ) : Time) = 1 := rfl @[simp] lemma ofNat_val {n : ℕ} : val (OfNat.ofNat n : Time) = n := rfl -lemma one_ne_zero : (1 : Time) ≠ (0 : Time) := by - by_contra h - rw [Time.ext_iff, ofNat_val, ofNat_val] at h - norm_cast at h +lemma one_ne_zero : (1 : Time) ≠ (0 : Time) := + mt (congrArg val) (Nat.cast_injective.ne Nat.one_ne_zero) @[simp] -lemma zero_val : val 0 = 0 := by - rw [ofNat_val] - norm_cast +lemma zero_val : val 0 = 0 := by exact_mod_cast ofNat_val (n := 0) @[simp] -lemma eq_zero_iff (t : Time) : t = 0 ↔ t.val = 0 := by - aesop +lemma eq_zero_iff (t : Time) : t = 0 ↔ t.val = 0 := by simp [Time.ext_iff] @[simp] -lemma one_val : val 1 = 1 := by - rw [ofNat_val] - norm_cast +lemma one_val : val 1 = 1 := by exact_mod_cast ofNat_val (n := 1) @[simp] -lemma eq_one_iff (t : Time) : t = 1 ↔ t.val = 1 := by - aesop +lemma eq_one_iff (t : Time) : t = 1 ↔ t.val = 1 := by simp [Time.ext_iff] /-! @@ -188,14 +177,7 @@ instance : PartialOrder Time where le_antisymm t1 t2 h1 h2 := by simp_all [le_def]; ext; exact le_antisymm h1 h2 lemma lt_def (t1 t2 : Time) : - t1 < t2 ↔ t1.val < t2.val := by - constructor - · intro h - exact lt_iff_le_not_ge.mpr h - · intro h - apply lt_iff_le_not_ge.mpr - simp_all [le_def] - apply le_of_lt h + t1 < t2 ↔ t1.val < t2.val := by simp only [lt_iff_le_not_ge, le_def] /-! @@ -407,34 +389,17 @@ lemma basis_apply_eq_one (i : Fin 1) : rfl @[simp] -lemma rank_eq_one : Module.rank ℝ Time = 1 := by - rw [@rank_eq_one_iff] - use 1 - constructor - · simp - · intro v - use v.val - ext - simp [one_val] +lemma rank_eq_one : Module.rank ℝ Time = 1 := + rank_eq_one_iff.mpr ⟨1, one_ne_zero, fun v => ⟨v.val, Time.ext (by simp)⟩⟩ @[simp] -lemma finRank_eq_one : Module.finrank ℝ Time = 1 := by - rw [@finrank_eq_one_iff'] - use 1 - constructor - · simp - · intro v - use v.val - ext - simp [one_val] +lemma finRank_eq_one : Module.finrank ℝ Time = 1 := + Module.rank_eq_one_iff_finrank_eq_one.mp rank_eq_one -instance : FiniteDimensional ℝ Time := by - refine Module.finite_of_rank_eq_one ?_ - simp +instance : FiniteDimensional ℝ Time := Module.finite_of_rank_eq_one rank_eq_one lemma volume_eq_basis_addHaar : - (volume (α := Time)) = basis.toBasis.addHaar := by - exact (OrthonormalBasis.addHaar_eq_volume _).symm + (volume (α := Time)) = basis.toBasis.addHaar := basis.addHaar_eq_volume.symm /-! @@ -473,36 +438,23 @@ noncomputable def toRealLIE : Time ≃ₗᵢ[ℝ] ℝ where rfl lemma eq_one_smul (t : Time) : - t = t.val • 1 := by - ext - simp [one_val] + t = t.val • 1 := Time.ext (by simp) @[fun_prop] -lemma val_measurable : Measurable Time.val := by - change Measurable toRealCLE - fun_prop - -lemma val_measurableEmbedding : MeasurableEmbedding Time.val where - injective := val_injective - measurable := by fun_prop - measurableSet_image' := by - intro s hs - change MeasurableSet (⇑toRealCLE '' s) - rw [ContinuousLinearEquiv.image_eq_preimage_symm] - exact toRealCLE.symm.continuous.measurable hs +lemma val_measurable : Measurable Time.val := toRealCLE.continuous.measurable + +lemma val_measurableEmbedding : MeasurableEmbedding Time.val := + toRealCLE.toHomeomorph.measurableEmbedding lemma val_measurePreserving : MeasurePreserving Time.val volume volume := LinearIsometryEquiv.measurePreserving toRealLIE @[fun_prop] -lemma val_differentiable : Differentiable ℝ Time.val := by - change Differentiable ℝ toRealCLM - fun_prop +lemma val_differentiable : Differentiable ℝ Time.val := toRealCLM.differentiable @[simp] lemma fderiv_val (t : Time) : fderiv ℝ Time.val t 1 = 1 := by - change (fderiv ℝ toRealCLM t 1) = 1 - rw [ContinuousLinearMap.fderiv, toRealCLM] - simp + rw [show Time.val = ⇑toRealCLM from rfl, ContinuousLinearMap.fderiv] + simp [toRealCLM] end Time diff --git a/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean b/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean index 480e656a9..75fb653f1 100644 --- a/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean +++ b/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean @@ -97,16 +97,14 @@ lemma space_apply (tx : TimeAndSpace d) : /-- The time projection is nonexpanding for the product metric. -/ lemma dist_time_le (tx ty : TimeAndSpace d) : dist (time tx) (time ty) ≤ dist tx ty := by - change dist tx.1 ty.1 ≤ dist tx ty rw [Prod.dist_eq] - exact le_max_left (dist tx.1 ty.1) (dist tx.2 ty.2) + exact le_max_left _ _ /-- The spatial projection is nonexpanding for the product metric. -/ lemma dist_space_le (tx ty : TimeAndSpace d) : dist (space tx) (space ty) ≤ dist tx ty := by - change dist tx.2 ty.2 ≤ dist tx ty rw [Prod.dist_eq] - exact le_max_right (dist tx.1 ty.1) (dist tx.2 ty.2) + exact le_max_right _ _ end TimeAndSpace @@ -123,11 +121,10 @@ lemma fderiv_space_eq_fderiv_curry {M} [NormedAddCommGroup M] [NormedSpace ℝ M (hf : Differentiable ℝ ↿f) : fderiv ℝ (fun x' => f t x') x dx = fderiv ℝ ↿f (t, x) (0, dx) := by change fderiv ℝ (↿f ∘ fun x' => (t, x')) x dx = _ - rw [fderiv_comp] - simp only [ContinuousLinearMap.coe_comp, Function.comp_apply] - rw [DifferentiableAt.fderiv_prodMk] - simp only [fderiv_fun_const, Pi.zero_apply, fderiv_fun_id, ContinuousLinearMap.prod_apply, - _root_.zero_apply, ContinuousLinearMap.coe_id', id_eq] + rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] + simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_fun_const, Pi.zero_apply, + fderiv_fun_id, ContinuousLinearMap.prod_apply, _root_.zero_apply, + ContinuousLinearMap.coe_id', id_eq] repeat' fun_prop lemma fderiv_time_eq_fderiv_curry {M} [NormedAddCommGroup M] [NormedSpace ℝ M] @@ -135,11 +132,10 @@ lemma fderiv_time_eq_fderiv_curry {M} [NormedAddCommGroup M] [NormedSpace ℝ M] (hf : Differentiable ℝ ↿f) : fderiv ℝ (fun t' => f t' x) t dt = fderiv ℝ ↿f (t, x) (dt, 0) := by change fderiv ℝ (↿f ∘ fun t' => (t', x)) t dt = _ - rw [fderiv_comp] - simp only [ContinuousLinearMap.coe_comp, Function.comp_apply] - rw [DifferentiableAt.fderiv_prodMk] - simp only [fderiv_fun_id, fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.prod_apply, - ContinuousLinearMap.coe_id', id_eq, _root_.zero_apply] + rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] + simp only [ContinuousLinearMap.coe_comp, Function.comp_apply, fderiv_fun_id, fderiv_fun_const, + Pi.zero_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, + _root_.zero_apply] repeat' fun_prop /-! @@ -235,10 +231,7 @@ lemma curl_differentiable_time Differentiable ℝ (fun t => (∇ ⨯ fₜ t) x) := by rw [differentiable_euclidean] intro i - fin_cases i - all_goals - simp only [Fin.zero_eta, Fin.isValue, curl] - fun_prop + fin_cases i <;> simp only [Fin.zero_eta, Fin.isValue, curl] <;> fun_prop /-! @@ -282,8 +275,6 @@ lemma space_fun_of_time_deriv_eq_zero {d} {M} [NormedAddCommGroup M] [NormedSpac ∃ (g : Space d → M), ∀ t x, f t x = g x := by use fun x => f 0 x intro t x - simp only - change (fun t' => f t' x) t = (fun t' => f t' x) 0 apply is_const_of_fderiv_eq_zero (f := fun t' => f t' x) (𝕜 := ℝ) · fun_prop intro t @@ -302,8 +293,6 @@ lemma time_fun_of_space_deriv_eq_zero {d} {M} [NormedAddCommGroup M] [NormedSpac ∃ (g : Time → M), ∀ t x, f t x = g t := by use fun t => f t 0 intro t x - simp only - change (fun x' => f t x') x = (fun x' => f t x') 0 apply is_const_of_fderiv_eq_zero (f := fun x' => f t x') (𝕜 := ℝ) · fun_prop intro x @@ -323,8 +312,7 @@ lemma const_of_time_deriv_space_deriv_eq_zero {d} {M} [NormedAddCommGroup M] [No obtain ⟨k, hk⟩ := time_fun_of_space_deriv_eq_zero hf h₂ use g 0 intro t x - have h1 : ∀ t x, g x = k t := fun t x => by rw [← hg t x, hk t x] - rw [hk, ← h1 t 0] + rw [hk t x, ← hk t 0, hg t 0] /-! @@ -464,9 +452,7 @@ lemma distSpaceDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] (i j : Fin d) (f : (Time × Space d) →d[ℝ] M) : distSpaceDeriv i (distSpaceDeriv j f) = distSpaceDeriv j (distSpaceDeriv i f) := by ext κ - rw [distSpaceDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] - rw [distSpaceDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] - simp only [neg_neg] + simp only [distSpaceDeriv_apply, fderivD_apply, neg_neg] congr 1 ext x change fderiv ℝ (fun x => fderiv ℝ κ x (0, basis i)) x (0, basis j) = @@ -501,9 +487,7 @@ lemma distTimeDeriv_commute_distSpaceDeriv {M d} [NormedAddCommGroup M] [NormedS (i : Fin d) (f : (Time × Space d) →d[ℝ] M) : distTimeDeriv (distSpaceDeriv i f) = distSpaceDeriv i (distTimeDeriv f) := by ext κ - rw [distTimeDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] - rw [distTimeDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] - simp only [neg_neg] + simp only [distTimeDeriv_apply, distSpaceDeriv_apply, fderivD_apply, neg_neg] congr 1 ext x change fderiv ℝ (fun x => fderiv ℝ κ x (1, 0)) x (0, basis i) = diff --git a/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean b/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean index 3cb0daf08..10457cdf2 100644 --- a/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean +++ b/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean @@ -87,9 +87,7 @@ lemma continuous_time_integral {d} (η : 𝓢(Time × Space d, ℝ)) : Continuous (fun x : Space d => ∫ t : Time, η (t, x)) := by obtain ⟨rt, hrt⟩ : ∃ r, Integrable (fun x : Time => ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by obtain ⟨r, h⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) - use r - convert h using 1 - funext x + refine ⟨r, h.congr <| Filter.Eventually.of_forall fun x => ?_⟩ simp only [norm_inv, norm_pow, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, zpow_natCast, inv_inj] rw [abs_of_nonneg (by positivity)] @@ -132,9 +130,7 @@ lemma continuous_time_integral {d} (η : 𝓢(Time × Space d, ℝ)) : filter_upwards with t exact h1 x t · apply Integrable.const_mul - convert hrt using 1 - funext t - simp + simpa using hrt · filter_upwards with t fun_prop @@ -154,16 +150,13 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x intro t x dsimp [F, F'] refine DifferentiableAt.hasFDerivAt ?_ - have hf := η.smooth' apply Differentiable.differentiableAt apply Differentiable.comp - · exact hf.differentiable (by simp) + · exact η.smooth'.differentiable (by simp) · fun_prop obtain ⟨rt, hrt⟩ : ∃ r, Integrable (fun x : Time => ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by obtain ⟨r, h⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) - use r - convert h using 1 - funext x + refine ⟨r, h.congr <| Filter.Eventually.of_forall fun x => ?_⟩ simp only [norm_inv, norm_pow, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, zpow_natCast, inv_inj] rw [abs_of_nonneg (by positivity)] @@ -277,9 +270,7 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x exact η.smooth'.differentiable (by simp) fun_prop · apply Integrable.const_mul - convert hrt using 1 - funext t - simp + simpa using hrt · filter_upwards with t intro x _ exact hF t x @@ -306,9 +297,7 @@ lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : S Integrable (fun t => fderiv ℝ (fun x => η (t, x)) x) volume := by obtain ⟨rt, hrt⟩ : ∃ r, Integrable (fun x : Time => ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by obtain ⟨r, h⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) - use r - convert h using 1 - funext x + refine ⟨r, h.congr <| Filter.Eventually.of_forall fun x => ?_⟩ simp only [norm_inv, norm_pow, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, zpow_natCast, inv_inj] rw [abs_of_nonneg (by positivity)] @@ -387,25 +376,20 @@ lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : S apply Integrable.mono' (g := fun t => k * ‖ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) (ContinuousLinearMap.id ℝ (Space d))‖ * (|1 + ‖t‖| ^ rt)⁻¹) · apply Integrable.const_mul - convert hrt using 1 - funext x - simp + simpa using hrt · apply Continuous.aestronglyMeasurable apply Continuous.comp · fun_prop · refine Continuous.fderiv_one ?_ ?_ - have hη := η.smooth' change ContDiff ℝ 1 η - apply hη.of_le (by simp) + apply η.smooth'.of_le (by simp) · fun_prop · filter_upwards with t - convert h2 x t using 1 - simp + simpa using h2 x t · apply Continuous.aestronglyMeasurable refine Continuous.fderiv_one ?_ ?_ - have hη := η.smooth' change ContDiff ℝ 1 η - apply hη.of_le (by simp) + apply η.smooth'.of_le (by simp) · fun_prop /-! @@ -520,9 +504,7 @@ lemma pow_mul_iteratedFDeriv_norm_le {n m} {d : ℕ} : ‖(1 + ‖t‖) ^ (rt)‖⁻¹ := by obtain ⟨rt, hrt⟩ : ∃ r, Integrable (fun x : Time => ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by obtain ⟨r, h⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) - use r - convert h using 1 - funext x + refine ⟨r, h.congr <| Filter.Eventually.of_forall fun x => ?_⟩ simp only [norm_inv, norm_pow, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, zpow_natCast, inv_inj] rw [abs_of_nonneg (by positivity)] @@ -593,8 +575,7 @@ lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Ti ((Finset.Iic (rt + m, n)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η) * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) · apply Integrable.const_mul - convert hrt using 1 - simp + simpa using hrt · apply Continuous.aestronglyMeasurable apply Continuous.mul · fun_prop @@ -602,15 +583,11 @@ lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Ti apply Continuous.comp' apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) refine Nat.cast_le.mpr (by omega) - have hη := η.smooth' - apply hη.of_le (ENat.LEInfty.out) + apply η.smooth'.of_le (ENat.LEInfty.out) fun_prop · filter_upwards with t - apply le_trans _ (hbound t) - apply le_of_eq - simp only [Prod.norm_mk, norm_mul, norm_pow, Real.norm_eq_abs] - rw [abs_of_nonneg (by positivity)] - simp + rw [Real.norm_of_nonneg (by positivity)] + exact hbound t /-! @@ -622,9 +599,7 @@ lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Ti lemma iteratedFDeriv_norm_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : Integrable (fun t => ‖iteratedFDeriv ℝ n ⇑η (t, x)‖) volume := by - convert iteratedFDeriv_norm_mul_pow_integrable n 0 η x using 1 - funext t - simp + simpa using iteratedFDeriv_norm_mul_pow_integrable n 0 η x @[fun_prop] lemma iteratedFDeriv_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : @@ -641,8 +616,7 @@ lemma iteratedFDeriv_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) apply Continuous.comp' apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) refine Nat.cast_le.mpr (by omega) - have hη := η.smooth' - apply hη.of_le (ENat.LEInfty.out) + apply η.smooth'.of_le (ENat.LEInfty.out) fun_prop /-! @@ -663,13 +637,13 @@ lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × intro m refine ContDiff.differentiable_iteratedFDeriv (n := (m + 1 : ℕ)) ?_ ?_ · exact Nat.cast_lt.mpr (by omega) - · exact η.smooth'.of_le (by exact ENat.LEInfty.out) + · exact η.smooth'.of_le ENat.LEInfty.out have hη_diff' : ∀ (m : ℕ) (t : Time), Differentiable ℝ (iteratedFDeriv ℝ m (fun x => η (t, x))) := by intro m t refine ContDiff.differentiable_iteratedFDeriv (n := (m + 1 : ℕ)) ?_ ?_ · exact Nat.cast_lt.mpr (by omega) - · exact (η.smooth'.of_le (by exact ENat.LEInfty.out)).comp (by fun_prop) + · exact (η.smooth'.of_le ENat.LEInfty.out).comp (by fun_prop) induction n with | zero => simp @@ -829,8 +803,7 @@ lemma time_integral_mul_pow_iteratedFDeriv_norm_le {d : ℕ} (n m : ℕ) : exact hrt · refine Pi.le_def.mpr ?_ intro t - convert! hbound t using 1 - simp + simpa using hbound t apply le_of_eq rw [MeasureTheory.integral_const_mul] ring @@ -920,8 +893,7 @@ lemma constantTime_distSpaceDeriv {M : Type} {d : ℕ} [NormedAddCommGroup M] [N calc _ _ = fderiv ℝ (fun x => ∫ t, η (t, x) ∂volume) x (basis i) := by rfl _ = (∫ t, fderiv ℝ (fun x => η (t, x)) x) (basis i) := by - have h1 := time_integral_hasFDerivAt (η) x - rw [h1.fderiv] + rw [(time_integral_hasFDerivAt η x).fderiv] _ = (∫ t, fderiv ℝ (fun x => η (t, x)) x (basis i)) := by rw [ContinuousLinearMap.integral_apply] exact integrable_fderiv_space η x @@ -949,8 +921,7 @@ lemma constantTime_distSpaceGrad {d : ℕ} (f : (Space d) →d[ℝ] ℝ) : ext η i simp [constantTime_apply] rw [Space.distSpaceGrad_apply, Space.distGrad_apply] - simp only - rw [constantTime_distSpaceDeriv, constantTime_apply] + simp [constantTime_distSpaceDeriv, constantTime_apply] /-! diff --git a/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean b/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean index ff8e5c1aa..6e2992d85 100644 --- a/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean +++ b/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean @@ -182,8 +182,7 @@ noncomputable def congr (e : ι1 ≃ᵐ ι) : CanonicalEnsemble ι1 where @[simp] lemma congr_energy_comp_symmm (e : ι1 ≃ᵐ ι) : (𝓒.congr e).energy ∘ e.symm = 𝓒.energy := by - funext i - simp [congr] + simp [congr, Function.comp_def] /-- Scalar multiplication of `CanonicalEnsemble`, defined such that `nsmul n 𝓒` represents `n` non-interacting, distinguishable copies of the ensemble `𝓒`. -/ @@ -231,11 +230,8 @@ lemma μ_add : (𝓒 + 𝓒1).μ = 𝓒.μ.prod 𝓒1.μ := rfl lemma μ_nsmul (n : ℕ) : (nsmul n 𝓒).μ = MeasureTheory.Measure.pi fun _ => 𝓒.μ := rfl -lemma μ_nsmul_zero_eq : (nsmul 0 𝓒).μ = Measure.pi (fun _ => 0) := by - simp [nsmul] - congr - funext x - exact Fin.elim0 x +lemma μ_nsmul_zero_eq : (nsmul 0 𝓒).μ = Measure.pi (fun _ => 0) := + congrArg Measure.pi (Subsingleton.elim _ _) /-! @@ -262,14 +258,10 @@ open MeasureTheory lemma nsmul_succ (n : ℕ) [SigmaFinite 𝓒.μ] : nsmul n.succ 𝓒 = (𝓒 + nsmul n 𝓒).congr (MeasurableEquiv.piFinSuccAbove (fun _ => ι) 0) := by ext1 - · ext x - simp only [Nat.succ_eq_add_one, energy_nsmul_apply] - exact Fin.sum_univ_succAbove (fun i => 𝓒.energy (x i)) 0 - · simp [Nat.succ_eq_add_one, Nat.succ_mul, dof_nsmul, add_comm] + · exact funext fun x => Fin.sum_univ_succAbove (fun i => 𝓒.energy (x i)) 0 + · simp [Nat.succ_mul, add_comm] · simp - · refine Eq.symm (MeasureTheory.MeasurePreserving.map_eq ?_) - refine MeasurePreserving.symm _ ?_ - exact MeasureTheory.measurePreserving_piFinSuccAbove (n := n) (fun _ => 𝓒.μ) 0 + · exact (((measurePreserving_piFinSuccAbove (fun _ => 𝓒.μ) 0).symm _).map_eq).symm /-! @@ -278,36 +270,18 @@ lemma nsmul_succ (n : ℕ) [SigmaFinite 𝓒.μ] : nsmul n.succ 𝓒 = (𝓒 + n -/ instance [NeZero 𝓒.μ] [NeZero 𝓒1.μ] : NeZero (𝓒 + 𝓒1).μ := by - simp [μ_add] - refine { out := ?_ } - rw [← @Measure.measure_univ_pos] - have h1 : (𝓒.μ.prod (𝓒1.μ)) Set.univ = - (𝓒.μ Set.univ) * (𝓒1.μ Set.univ) := by - rw [← @Measure.prod_prod] - simp - rw [h1] - exact NeZero.pos (𝓒.μ Set.univ * 𝓒1.μ Set.univ) + refine ⟨Measure.measure_univ_ne_zero.mp ?_⟩ + rw [μ_add, ← Set.univ_prod_univ, Measure.prod_prod] + exact NeZero.ne _ instance μ_neZero_congr [NeZero 𝓒.μ] (e : ι1 ≃ᵐ ι) : - NeZero (𝓒.congr e).μ := by - refine { out := ?_ } - rw [← @Measure.measure_univ_pos] - simp only [Measure.measure_univ_pos, ne_eq] - refine (Measure.map_ne_zero_iff ?_).mpr ?_ - · fun_prop - · exact Ne.symm (NeZero.ne' _) + NeZero (𝓒.congr e).μ := + ⟨(Measure.map_ne_zero_iff e.symm.measurable.aemeasurable).mpr (NeZero.ne _)⟩ instance [NeZero 𝓒.μ] (n : ℕ) : NeZero (nsmul n 𝓒).μ := by - induction n with - | zero => - rw [μ_nsmul_zero_eq] - rw [@neZero_iff] - simp only [ne_eq] - refine Measure.measure_univ_ne_zero.mp ?_ - simp - | succ n ih => - rw [nsmul_succ] - infer_instance + refine ⟨Measure.measure_univ_ne_zero.mp ?_⟩ + rw [μ_nsmul, Measure.pi_univ] + exact Finset.prod_ne_zero_iff.mpr fun i _ => Measure.measure_univ_ne_zero.mpr (NeZero.ne _) /-! @@ -328,12 +302,9 @@ lemma μBolt_add (T : Temperature) : (𝓒 + 𝓒1).μBolt T = (𝓒.μBolt T).prod (𝓒1.μBolt T) := by simp_rw [μBolt, μ_add] rw [MeasureTheory.prod_withDensity] - congr - funext i - rw [← ENNReal.ofReal_mul, ← Real.exp_add] - simp only [energy_add_apply, neg_mul] - ring_nf - · exact exp_nonneg _ + · congr with i + rw [← ENNReal.ofReal_mul (exp_nonneg _), ← Real.exp_add] + simp only [energy_add_apply, mul_add] · fun_prop · fun_prop @@ -341,43 +312,27 @@ lemma μBolt_congr (e : ι1 ≃ᵐ ι) (T : Temperature) : (𝓒.congr e).μBolt (𝓒.μBolt T).map e.symm := by simp [congr, μBolt] refine Measure.ext_of_lintegral _ fun φ hφ ↦ ?_ - rw [lintegral_withDensity_eq_lintegral_mul₀] - rw [lintegral_map, lintegral_map, lintegral_withDensity_eq_lintegral_mul₀] - congr - funext i - simp only [Pi.mul_apply, MeasurableEquiv.apply_symm_apply] - repeat fun_prop + rw [lintegral_withDensity_eq_lintegral_mul₀, lintegral_map, lintegral_map, + lintegral_withDensity_eq_lintegral_mul₀] + · congr with i + simp + all_goals fun_prop lemma μBolt_nsmul [SigmaFinite 𝓒.μ] (n : ℕ) (T : Temperature) : (nsmul n 𝓒).μBolt T = MeasureTheory.Measure.pi fun _ => (𝓒.μBolt T) := by induction n with | zero => simp [nsmul, μBolt] - congr - funext x - exact Fin.elim0 x + exact congrArg Measure.pi (Subsingleton.elim _ _) | succ n ih => - rw [nsmul_succ, μBolt_congr] - rw [μBolt_add] - refine MeasurePreserving.map_eq ?_ - refine MeasurePreserving.symm _ ?_ - rw [ih] - exact MeasureTheory.measurePreserving_piFinSuccAbove (fun _ => 𝓒.μBolt T) 0 + rw [nsmul_succ, μBolt_congr, μBolt_add, ih] + exact ((measurePreserving_piFinSuccAbove (fun _ => 𝓒.μBolt T) 0).symm _).map_eq lemma μBolt_ne_zero_of_μ_ne_zero (T : Temperature) (h : 𝓒.μ ≠ 0) : 𝓒.μBolt T ≠ 0 := by - simp [μBolt] at ⊢ h - rw [Measure.ext_iff'] at ⊢ h - simp only [Measure.coe_zero, Pi.zero_apply] - have hs : {x | ENNReal.ofReal (rexp (-(↑T.β * 𝓒.energy x))) ≠ 0} = Set.univ := by - ext i - simp only [ne_eq, ENNReal.ofReal_eq_zero, not_le, Set.mem_setOf_eq, Set.mem_univ, iff_true] - exact exp_pos _ - conv => - enter [1, s] - rw [MeasureTheory.withDensity_apply_eq_zero' (by fun_prop), hs] - simp - simpa using h + have hm : AEMeasurable (fun i => ENNReal.ofReal (exp (- T.β * 𝓒.energy i))) 𝓒.μ := by fun_prop + rw [μBolt, ne_eq, withDensity_eq_zero_iff hm, Filter.EventuallyEq, ae_iff] + simpa [ENNReal.ofReal_eq_zero, exp_pos] using h instance (T : Temperature) [NeZero 𝓒.μ] : NeZero (𝓒.μBolt T) := by refine { out := ?_ } @@ -405,16 +360,11 @@ noncomputable def mathematicalPartitionFunction (T : Temperature) : ℝ := (𝓒 lemma mathematicalPartitionFunction_eq_integral (T : Temperature) : mathematicalPartitionFunction 𝓒 T = ∫ i, exp (- T.β * 𝓒.energy i) ∂𝓒.μ := by - trans ∫ i, 1 ∂𝓒.μBolt T - · simp only [integral_const, smul_eq_mul, mul_one] - rfl - rw [μBolt] - erw [integral_withDensity_eq_integral_smul] - congr - funext x - simp [HSMul.hSMul, SMul.smul] - · exact exp_nonneg _ + rw [mathematicalPartitionFunction, measureReal_def, μBolt, withDensity_apply _ .univ, + setLIntegral_univ, ← integral_toReal] + · simp [ENNReal.toReal_ofReal, exp_nonneg] · fun_prop + · exact .of_forall fun i => ENNReal.ofReal_lt_top lemma mathematicalPartitionFunction_add {T : Temperature} : (𝓒 + 𝓒1).mathematicalPartitionFunction T = @@ -425,39 +375,23 @@ lemma mathematicalPartitionFunction_add {T : Temperature} : @[simp] lemma mathematicalPartitionFunction_congr (e : ι1 ≃ᵐ ι) (T : Temperature) : (𝓒.congr e).mathematicalPartitionFunction T = 𝓒.mathematicalPartitionFunction T := by - rw [mathematicalPartitionFunction_eq_integral, mathematicalPartitionFunction_eq_integral] - simp only [congr] - rw [integral_map_equiv] - simp + simp [mathematicalPartitionFunction, μBolt_congr, measureReal_def, MeasurableEquiv.map_apply] /-- The `mathematicalPartitionFunction_nsmul` function of `n` copies of a canonical ensemble. -/ lemma mathematicalPartitionFunction_nsmul (n : ℕ) (T : Temperature) : (nsmul n 𝓒).mathematicalPartitionFunction T = (𝓒.mathematicalPartitionFunction T) ^ n := by - simp_rw [mathematicalPartitionFunction, μBolt_nsmul, measureReal_def, Measure.pi_univ] - simp + simp [mathematicalPartitionFunction, μBolt_nsmul, measureReal_def, Measure.pi_univ] lemma mathematicalPartitionFunction_nonneg (T : Temperature) : - 0 ≤ 𝓒.mathematicalPartitionFunction T := by - rw [mathematicalPartitionFunction]; exact measureReal_nonneg + 0 ≤ 𝓒.mathematicalPartitionFunction T := measureReal_nonneg lemma mathematicalPartitionFunction_eq_zero_iff (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] : mathematicalPartitionFunction 𝓒 T = 0 ↔ 𝓒.μ = 0 := by - simp [mathematicalPartitionFunction] - rw [measureReal_def] - rw [ENNReal.toReal_eq_zero_iff] + rw [mathematicalPartitionFunction, measureReal_def, ENNReal.toReal_eq_zero_iff] simp only [measure_ne_top, or_false] - rw [μBolt] - rw [MeasureTheory.withDensity_apply_eq_zero'] - simp only [neg_mul, ne_eq, ENNReal.ofReal_eq_zero, not_le, Set.inter_univ] - let s : Set ι := {x | 0 < rexp (-(T.β * 𝓒.energy x))} - have h : s = Set.univ := by - ext i - simp [s] - exact exp_pos (-(T.β * 𝓒.energy i)) - change 𝓒.μ s = 0 ↔ 𝓒.μ = 0 - rw [h] - simp only [Measure.measure_univ_eq_zero] - fun_prop + rw [μBolt, MeasureTheory.withDensity_apply_eq_zero'] + · simp [ENNReal.ofReal_eq_zero, exp_pos] + · fun_prop open NNReal @@ -489,8 +423,7 @@ noncomputable def probability (T : Temperature) (i : ι) : ℝ := lemma probability_add {T : Temperature} (i : ι × ι1) : (𝓒 + 𝓒1).probability T i = 𝓒.probability T i.1 * 𝓒1.probability T i.2 := by - simp [probability, mathematicalPartitionFunction_add, mul_add, Real.exp_add] - ring + simp [probability, mathematicalPartitionFunction_add, mul_add, Real.exp_add, div_mul_div_comm] @[simp] lemma probability_congr (e : ι1 ≃ᵐ ι) (T : Temperature) (i : ι1) : @@ -500,16 +433,12 @@ lemma probability_congr (e : ι1 ≃ᵐ ι) (T : Temperature) (i : ι1) : lemma probability_nsmul (n : ℕ) (T : Temperature) (f : Fin n → ι) : (nsmul n 𝓒).probability T f = ∏ i, 𝓒.probability T (f i) := by induction n with - | zero => - simp [probability, mathematicalPartitionFunction_nsmul] + | zero => simp [probability, mathematicalPartitionFunction_nsmul] | succ n ih => - rw [nsmul_succ] - rw [probability_congr] - rw [probability_add] + rw [nsmul_succ, probability_congr, probability_add] simp only [MeasurableEquiv.piFinSuccAbove_apply, Fin.insertNthEquiv_zero, - Fin.consEquiv_symm_apply] - rw [ih] - exact Eq.symm (Fin.prod_univ_succAbove (fun i => 𝓒.probability T (f i)) 0) + Fin.consEquiv_symm_apply, ih] + exact (Fin.prod_univ_succAbove (fun i => 𝓒.probability T (f i)) 0).symm /-- The probability measure associated with the Boltzmann distribution of a canonical ensemble. -/ @@ -523,51 +452,29 @@ instance (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : IsProbabilityMeasure (𝓒.μProd T) := inferInstanceAs <| IsProbabilityMeasure ((𝓒.μBolt T Set.univ)⁻¹ • 𝓒.μBolt T) -instance {T} : IsFiniteMeasure (𝓒.μProd T) := by - rw [μProd] - infer_instance +instance {T} : IsFiniteMeasure (𝓒.μProd T) := + inferInstanceAs (IsFiniteMeasure ((𝓒.μBolt T Set.univ)⁻¹ • 𝓒.μBolt T)) lemma μProd_add {T : Temperature} [IsFiniteMeasure (𝓒.μBolt T)] [IsFiniteMeasure (𝓒1.μBolt T)] : (𝓒 + 𝓒1).μProd T = (𝓒.μProd T).prod (𝓒1.μProd T) := by - rw [μProd, μProd, μProd, μBolt_add] - rw [MeasureTheory.Measure.prod_smul_left, MeasureTheory.Measure.prod_smul_right] - rw [smul_smul] - congr - trans ((𝓒.μBolt T) Set.univ * (𝓒1.μBolt T) Set.univ)⁻¹ - swap - · by_cases h : (𝓒.μBolt T) Set.univ = 0 - · simp [h] - by_cases h1 : (𝓒1.μBolt T) Set.univ = 0 - · simp [h1] - rw [ENNReal.mul_inv] - · simp - · simp - · rw [← @Measure.prod_prod] - simp + rw [μProd, μProd, μProd, μBolt_add, Measure.prod_smul_left, Measure.prod_smul_right, smul_smul] + congr 1 + rw [← ENNReal.mul_inv (.inr (measure_ne_top _ _)) (.inl (measure_ne_top _ _)), + ← Measure.prod_prod, Set.univ_prod_univ] lemma μProd_congr (e : ι1 ≃ᵐ ι) (T : Temperature) : (𝓒.congr e).μProd T = (𝓒.μProd T).map e.symm := by - simp [μProd, μBolt_congr] - congr 2 - rw [MeasurableEquiv.map_apply] - simp + rw [μProd, μProd, μBolt_congr, Measure.map_smul, MeasurableEquiv.map_apply, Set.preimage_univ] lemma μProd_nsmul (n : ℕ) (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] : (nsmul n 𝓒).μProd T = MeasureTheory.Measure.pi fun _ => 𝓒.μProd T := by induction n with | zero => simp [nsmul, μProd, μBolt] - congr - funext x - exact Fin.elim0 x + exact congrArg Measure.pi (Subsingleton.elim _ _) | succ n ih => - rw [nsmul_succ] - rw [μProd_congr] - rw [μProd_add] - refine MeasurePreserving.map_eq ?_ - refine MeasurePreserving.symm _ ?_ - rw [ih] - exact MeasureTheory.measurePreserving_piFinSuccAbove (fun _ => 𝓒.μProd T) 0 + rw [nsmul_succ, μProd_congr, μProd_add, ih] + exact ((measurePreserving_piFinSuccAbove (fun _ => 𝓒.μProd T) 0).symm _).map_eq /-! @@ -581,30 +488,14 @@ lemma integrable_energy_add (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] (h : Integrable 𝓒.energy (𝓒.μProd T)) (h1 : Integrable 𝓒1.energy (𝓒1.μProd T)) : Integrable (𝓒 + 𝓒1).energy ((𝓒 + 𝓒1).μProd T) := by rw [μProd_add] - refine MeasureTheory.Integrable.fun_add ?_ ?_ - · have h1 : (fun (i : ι × ι1) => 𝓒.energy i.1) - = fun (i : ι × ι1) => 𝓒.energy i.1 * (fun (i : ι1) => 1) i.2 := by - funext i - simp - rw [h1] - apply Integrable.mul_prod (f := 𝓒.energy) (g := (fun (i : ι1) => 1)) - · fun_prop - · fun_prop - · have h1 : (fun (i : ι × ι1) => 𝓒1.energy i.2) - = fun (i : ι × ι1) => (fun (i : ι) => 1) i.1 * 𝓒1.energy i.2 := by - funext i - simp - rw [h1] - apply Integrable.mul_prod (f := (fun (i : ι) => 1)) (g := 𝓒1.energy) <;> fun_prop + exact (h.comp_fst _).fun_add (h1.comp_snd _) @[fun_prop] lemma integrable_energy_congr (T : Temperature) (e : ι1 ≃ᵐ ι) (h : Integrable 𝓒.energy (𝓒.μProd T)) : Integrable (𝓒.congr e).energy ((𝓒.congr e).μProd T) := by - simp [μProd_congr] - refine (integrable_map_equiv e.symm (𝓒.congr e).energy).mpr ?_ - simp only [congr_energy_comp_symmm] - exact h + rw [μProd_congr] + exact (integrable_map_equiv e.symm _).mpr (by simpa only [congr_energy_comp_symmm] using h) @[fun_prop] lemma integrable_energy_nsmul (n : ℕ) (T : Temperature) @@ -612,14 +503,10 @@ lemma integrable_energy_nsmul (n : ℕ) (T : Temperature) (h : Integrable 𝓒.energy (𝓒.μProd T)) : Integrable (nsmul n 𝓒).energy ((nsmul n 𝓒).μProd T) := by induction n with - | zero => - simp [nsmul] + | zero => simp [nsmul] | succ n ih => rw [nsmul_succ] - apply integrable_energy_congr - apply integrable_energy_add - · exact h - · exact ih + exact integrable_energy_congr _ _ _ (integrable_energy_add _ _ _ h ih) /-! @@ -644,45 +531,27 @@ lemma meanEnergy_add {T : Temperature} (h1 : Integrable 𝓒.energy (𝓒.μProd T)) (h2 : Integrable 𝓒1.energy (𝓒1.μProd T)) : (𝓒 + 𝓒1).meanEnergy T = 𝓒.meanEnergy T + 𝓒1.meanEnergy T := by - rw [meanEnergy] - simp only [energy_add_apply] - rw [μProd_add] - rw [MeasureTheory.integral_prod] - simp only - conv_lhs => - enter [2, x] - rw [integral_add (integrable_const _) h2] - rw [integral_const] - simp - rw [integral_add h1 (integrable_const _)] - rw [integral_const] - simp - rfl - · have h1 := integrable_energy_add 𝓒 𝓒1 T h1 h2 - simp_all only [μProd_add] - exact h1 + have hI := integrable_energy_add 𝓒 𝓒1 T h1 h2 + rw [μProd_add] at hI + rw [meanEnergy, μProd_add, integral_prod _ hI] + simp [integral_add (integrable_const _) h2, integral_add h1 (integrable_const _), meanEnergy] lemma meanEnergy_congr (e : ι1 ≃ᵐ ι) (T : Temperature) : (𝓒.congr e).meanEnergy T = 𝓒.meanEnergy T := by - simp [meanEnergy, μProd_congr] - refine MeasurePreserving.integral_comp' ?_ 𝓒.energy - refine { measurable := ?_, map_eq := ?_ } - · exact MeasurableEquiv.measurable e - · exact MeasurableEquiv.map_map_symm e + simp only [meanEnergy, μProd_congr] + exact MeasurePreserving.integral_comp' ⟨e.measurable, e.map_map_symm⟩ 𝓒.energy lemma meanEnergy_nsmul (n : ℕ) (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (h1 : Integrable 𝓒.energy (𝓒.μProd T)) : (nsmul n 𝓒).meanEnergy T = n * 𝓒.meanEnergy T := by induction n with - | zero => - simp [nsmul, meanEnergy] + | zero => simp [nsmul, meanEnergy] | succ n ih => - rw [nsmul_succ, meanEnergy_congr, meanEnergy_add, ih] - simp only [Nat.cast_add, Nat.cast_one] + rw [nsmul_succ, meanEnergy_congr, + meanEnergy_add _ _ h1 (integrable_energy_nsmul 𝓒 n T h1), ih] + push_cast ring - · exact h1 - · exact integrable_energy_nsmul 𝓒 n T h1 /-! @@ -699,16 +568,14 @@ noncomputable def differentialEntropy (T : Temperature) : ℝ := /-- Probabilities are non-negative, assuming a positive partition function. -/ lemma probability_nonneg (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (i : ι) : - 0 ≤ 𝓒.probability T i := by - have hpos := mathematicalPartitionFunction_pos (𝓒:=𝓒) (T:=T) - simp [CanonicalEnsemble.probability, div_nonneg, Real.exp_nonneg, hpos.le] + 0 ≤ 𝓒.probability T i := + div_nonneg (exp_nonneg _) (𝓒.mathematicalPartitionFunction_nonneg T) /-- Probabilities are strictly positive. -/ lemma probability_pos (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (i : ι) : - 0 < 𝓒.probability T i := by - have hZpos := mathematicalPartitionFunction_pos (𝓒:=𝓒) (T:=T) - simp [probability, Real.exp_pos, hZpos] + 0 < 𝓒.probability T i := + div_pos (exp_pos _) (𝓒.mathematicalPartitionFunction_pos T) /-- General entropy non-negativity under a pointwise upper bound `probability ≤ 1`. This assumption holds automatically in the finite/counting case (since sums bound each term), @@ -719,29 +586,10 @@ lemma differentialEntropy_nonneg_of_prob_le_one (hInt : Integrable (fun i => Real.log (𝓒.probability T i)) (𝓒.μProd T)) (hP_le_one : ∀ i, 𝓒.probability T i ≤ 1) : 0 ≤ 𝓒.differentialEntropy T := by - have hPoint : - (fun i => Real.log (𝓒.probability T i)) ≤ᵐ[𝓒.μProd T] fun _ => 0 := by - refine Filter.Eventually.of_forall ?_ - intro i - have hpos := probability_pos (𝓒:=𝓒) (T:=T) i - have hle := hP_le_one i - have hle' : 𝓒.probability T i ≤ Real.exp 0 := by - simpa [Real.exp_zero] using hle - exact (log_le_iff_le_exp hpos).mpr hle' - have hInt0 : Integrable (fun _ : ι => (0 : ℝ)) (𝓒.μProd T) := integrable_const _ - have hIntLe : (∫ i, Real.log (𝓒.probability T i) ∂𝓒.μProd T) - ≤ (∫ _i, (0 : ℝ) ∂𝓒.μProd T) := - integral_mono_ae hInt hInt0 hPoint - have hent : - 𝓒.differentialEntropy T - = - kB * (∫ i, Real.log (𝓒.probability T i) ∂𝓒.μProd T) := rfl - have hkB : 0 ≤ kB := kB_nonneg - have hIle0 : (∫ i, Real.log (𝓒.probability T i) ∂𝓒.μProd T) ≤ 0 := by - simpa [integral_const] using hIntLe - have hProd : - 0 ≤ - kB * (∫ i, Real.log (𝓒.probability T i) ∂𝓒.μProd T) := - mul_nonneg_of_nonpos_of_nonpos (neg_nonpos.mpr hkB) hIle0 - simpa [hent] using hProd + rw [differentialEntropy] + refine mul_nonneg_of_nonpos_of_nonpos (neg_nonpos.mpr kB_nonneg) ?_ + simpa using integral_mono_ae hInt (integrable_const 0) (Filter.Eventually.of_forall fun i => + Real.log_nonpos (𝓒.probability_nonneg T i) (hP_le_one i)) /-! @@ -765,10 +613,8 @@ lemma partitionFunction_def (𝓒 : CanonicalEnsemble ι) (T : Temperature) : lemma partitionFunction_pos (𝓒 : CanonicalEnsemble ι) (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : - 0 < 𝓒.partitionFunction T := by - have hZ := 𝓒.mathematicalPartitionFunction_pos T - have hden : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ - simp [partitionFunction, hZ, hden] + 0 < 𝓒.partitionFunction T := + div_pos (𝓒.mathematicalPartitionFunction_pos T) (pow_pos 𝓒.hPos _) lemma partitionFunction_congr (𝓒 : CanonicalEnsemble ι) (e : ι1 ≃ᵐ ι) (T : Temperature) : @@ -781,16 +627,13 @@ lemma partitionFunction_add (h : 𝓒.phaseSpaceunit = 𝓒1.phaseSpaceunit) : (𝓒 + 𝓒1).partitionFunction T = 𝓒.partitionFunction T * 𝓒1.partitionFunction T := by - simp [partitionFunction, mathematicalPartitionFunction_add, h] - ring_nf + simp [partitionFunction, mathematicalPartitionFunction_add, h, pow_add, div_mul_div_comm] lemma partitionFunction_nsmul (𝓒 : CanonicalEnsemble ι) (n : ℕ) (T : Temperature) : (nsmul n 𝓒).partitionFunction T = (𝓒.partitionFunction T) ^ n := by - simp [partitionFunction, mathematicalPartitionFunction_nsmul, - dof_nsmul, phase_space_unit_nsmul, pow_mul] - ring_nf + simp [partitionFunction, mathematicalPartitionFunction_nsmul, pow_mul', div_pow] lemma partitionFunction_dof_zero (𝓒 : CanonicalEnsemble ι) (T : Temperature) (h : 𝓒.dof = 0) : @@ -808,14 +651,8 @@ lemma log_partitionFunction Real.log (𝓒.partitionFunction T) = Real.log (𝓒.mathematicalPartitionFunction T) - (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - have hZ := 𝓒.mathematicalPartitionFunction_pos T - have hden : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ - have hlogpow : - Real.log (𝓒.phaseSpaceunit ^ 𝓒.dof) - = (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - simp - simp [partitionFunction, Real.log_div hZ.ne' hden.ne', hlogpow, - sub_eq_add_neg] + rw [partitionFunction, Real.log_div (𝓒.mathematicalPartitionFunction_pos T).ne' + (pow_pos 𝓒.hPos _).ne', Real.log_pow] /-- A rewriting form convenient under a coercion to a temperature obtained from an inverse temperature. -/ @@ -868,42 +705,17 @@ lemma helmholtzFreeEnergy_add (h : 𝓒.phaseSpaceunit = 𝓒1.phaseSpaceunit) : (𝓒 + 𝓒1).helmholtzFreeEnergy T = 𝓒.helmholtzFreeEnergy T + 𝓒1.helmholtzFreeEnergy T := by - have hPF := partitionFunction_add (𝓒:=𝓒) (𝓒1:=𝓒1) (T:=T) h - have hpf₁ : 0 < 𝓒.partitionFunction T := partitionFunction_pos (𝓒:=𝓒) (T:=T) - have hpf₂ : 0 < 𝓒1.partitionFunction T := partitionFunction_pos (𝓒:=𝓒1) (T:=T) - calc - (𝓒 + 𝓒1).helmholtzFreeEnergy T - = -kB * T.val * Real.log ((𝓒 + 𝓒1).partitionFunction T) := rfl - _ = -kB * T.val * Real.log (𝓒.partitionFunction T * 𝓒1.partitionFunction T) := by - rw [hPF] - _ = -kB * T.val * - (Real.log (𝓒.partitionFunction T) + Real.log (𝓒1.partitionFunction T)) := by - rw [Real.log_mul hpf₁.ne' hpf₂.ne'] - _ = (-kB * T.val) * Real.log (𝓒.partitionFunction T) - + (-kB * T.val) * Real.log (𝓒1.partitionFunction T) := by - ring - _ = 𝓒.helmholtzFreeEnergy T + 𝓒1.helmholtzFreeEnergy T := by - simp [helmholtzFreeEnergy, mul_comm, mul_assoc] + simp only [helmholtzFreeEnergy] + rw [partitionFunction_add _ _ _ h, + Real.log_mul (partitionFunction_pos 𝓒 T).ne' (partitionFunction_pos 𝓒1 T).ne'] + ring lemma helmholtzFreeEnergy_nsmul (𝓒 : CanonicalEnsemble ι) (n : ℕ) (T : Temperature) : (nsmul n 𝓒).helmholtzFreeEnergy T = n * 𝓒.helmholtzFreeEnergy T := by - have hPF := partitionFunction_nsmul (𝓒:=𝓒) (n:=n) (T:=T) - have hlog : - Real.log ((nsmul n 𝓒).partitionFunction T) - = (n : ℝ) * Real.log (𝓒.partitionFunction T) := by - rw [hPF] - simp - calc - (nsmul n 𝓒).helmholtzFreeEnergy T - = -kB * T.val * Real.log ((nsmul n 𝓒).partitionFunction T) := rfl - _ = -kB * T.val * ((n : ℝ) * Real.log (𝓒.partitionFunction T)) := by - rw [hlog] - _ = (n : ℝ) * (-kB * T.val * Real.log (𝓒.partitionFunction T)) := by - ring - _ = n * 𝓒.helmholtzFreeEnergy T := by - simp [helmholtzFreeEnergy, mul_comm, mul_left_comm, mul_assoc] + simp only [helmholtzFreeEnergy, partitionFunction_nsmul, Real.log_pow] + ring /-- The dimensionless physical probability density. This is is the probability density w.r.t. the measure, obtained by dividing the phase space measure by the fundamental unit `h^dof`, making the @@ -918,66 +730,33 @@ lemma physicalProbability_def (T : Temperature) (i : ι) : lemma physicalProbability_measurable (T : Temperature) : Measurable (𝓒.physicalProbability T) := by - let c : ℝ := (𝓒.phaseSpaceunit ^ 𝓒.dof) / 𝓒.mathematicalPartitionFunction T - have h_energy_meas : Measurable fun i => 𝓒.energy i := 𝓒.energy_measurable - have h_mul_meas : Measurable fun i => (-(T.β : ℝ)) * 𝓒.energy i := by - simpa [mul_comm] using h_energy_meas.const_mul (-(T.β : ℝ)) - have h_exp_meas : Measurable fun i => Real.exp (-(T.β : ℝ) * 𝓒.energy i) := - (continuous_exp.measurable.comp h_mul_meas) - have h_fun_meas : Measurable fun i => c * Real.exp (-(T.β : ℝ) * 𝓒.energy i) := by - simpa [mul_comm] using (h_exp_meas.const_mul c) - have h_eq : - (fun i => 𝓒.physicalProbability T i) - = fun i => c * Real.exp (-(T.β : ℝ) * 𝓒.energy i) := by - funext i - simp [physicalProbability, probability, c, div_eq_mul_inv, - mul_comm, mul_assoc] - simpa [h_eq] using h_fun_meas + unfold physicalProbability probability + fun_prop lemma physicalProbability_nonneg (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (i : ι) : - 0 ≤ 𝓒.physicalProbability T i := by - have hp := 𝓒.probability_nonneg (T:=T) i - exact mul_nonneg hp (by exact pow_nonneg (le_of_lt 𝓒.hPos) _) + 0 ≤ 𝓒.physicalProbability T i := + mul_nonneg (𝓒.probability_nonneg T i) (pow_nonneg 𝓒.hPos.le _) lemma physicalProbability_pos (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (i : ι) : - 0 < 𝓒.physicalProbability T i := by - have hp := 𝓒.probability_pos (T:=T) i - exact mul_pos hp (pow_pos 𝓒.hPos _) + 0 < 𝓒.physicalProbability T i := + mul_pos (𝓒.probability_pos T i) (pow_pos 𝓒.hPos _) lemma log_physicalProbability (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (i : ι) : Real.log (𝓒.physicalProbability T i) = Real.log (𝓒.probability T i) + (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - have hppos := 𝓒.probability_pos (T:=T) i - have hpowpos : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ - simp [physicalProbability, Real.log_mul hppos.ne' hpowpos.ne', Real.log_pow] + rw [physicalProbability, Real.log_mul (𝓒.probability_pos T i).ne' (pow_pos 𝓒.hPos _).ne', + Real.log_pow] lemma integral_probability (𝓒 : CanonicalEnsemble ι) (T : Temperature) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : (∫ i, 𝓒.probability T i ∂ 𝓒.μ) = 1 := by - classical - have hZ : - 𝓒.mathematicalPartitionFunction T - = ∫ i, Real.exp (- T.β * 𝓒.energy i) ∂ 𝓒.μ := - mathematicalPartitionFunction_eq_integral (𝓒:=𝓒) (T:=T) - have hZpos : 0 < 𝓒.mathematicalPartitionFunction T := - 𝓒.mathematicalPartitionFunction_pos T - have h_int : - (∫ i, 𝓒.probability T i ∂ 𝓒.μ) - = (𝓒.mathematicalPartitionFunction T)⁻¹ * - (∫ i, Real.exp (- T.β * 𝓒.energy i) ∂ 𝓒.μ) := by - simp [probability, div_eq_mul_inv, integral_const_mul, - mul_comm] - calc - (∫ i, 𝓒.probability T i ∂ 𝓒.μ) - = (𝓒.mathematicalPartitionFunction T)⁻¹ * - (∫ i, Real.exp (- T.β * 𝓒.energy i) ∂ 𝓒.μ) := h_int - _ = (𝓒.mathematicalPartitionFunction T)⁻¹ * - 𝓒.mathematicalPartitionFunction T := by simp [hZ] - _ = 1 := by simp [hZpos.ne'] + simp only [probability, div_eq_mul_inv, integral_mul_const, + ← mathematicalPartitionFunction_eq_integral] + exact mul_inv_cancel₀ (𝓒.mathematicalPartitionFunction_pos T).ne' /-- Normalization of the dimensionless physical probability density over the base measure. -/ lemma integral_physicalProbability_base @@ -985,16 +764,7 @@ lemma integral_physicalProbability_base [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : (∫ i, 𝓒.physicalProbability T i ∂ 𝓒.μ) = 𝓒.phaseSpaceunit ^ 𝓒.dof := by - classical - have hnorm := integral_probability (𝓒:=𝓒) (T:=T) - calc - (∫ i, 𝓒.physicalProbability T i ∂ 𝓒.μ) - = (∫ i, 𝓒.probability T i * (𝓒.phaseSpaceunit ^ 𝓒.dof) ∂ 𝓒.μ) := by - simp [physicalProbability] - _ = (∫ i, 𝓒.probability T i ∂ 𝓒.μ) * (𝓒.phaseSpaceunit ^ 𝓒.dof) := by - simp [integral_mul_const, mul_comm] - _ = 1 * (𝓒.phaseSpaceunit ^ 𝓒.dof) := by simp [hnorm] - _ = 𝓒.phaseSpaceunit ^ 𝓒.dof := by ring + simp [physicalProbability, integral_mul_const, integral_probability] lemma physicalProbability_dof_zero (T : Temperature) (h : 𝓒.dof = 0) (i : ι) : @@ -1017,8 +787,8 @@ lemma physicalProbability_add (h : 𝓒.phaseSpaceunit = 𝓒1.phaseSpaceunit) : (𝓒 + 𝓒1).physicalProbability T i = 𝓒.physicalProbability T i.1 * 𝓒1.physicalProbability T i.2 := by - simp [physicalProbability, probability_add, phase_space_unit_add, dof_add, h, pow_add] - ring + simp [physicalProbability, probability_add, phase_space_unit_add, dof_add, h, pow_add, + mul_mul_mul_comm] /-- The absolute thermodynamic entropy, defined from its statistical mechanical foundation as the Gibbs-Shannon entropy of the dimensionless physical probability distribution. diff --git a/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean b/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean index f08cee5bf..c977e84d4 100644 --- a/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean +++ b/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean @@ -75,14 +75,8 @@ lemma helmholtzFreeEnergy_eq_helmholtzMathematicalFreeEnergy_add_correction (T : [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : 𝓒.helmholtzFreeEnergy T = 𝓒.mathematicalHelmholtzFreeEnergy T + kB * T.val * 𝓒.dof * Real.log (𝓒.phaseSpaceunit) := by - have hZ_pos := mathematicalPartitionFunction_pos 𝓒 T - have h_pow_pos : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ - simp_rw [helmholtzFreeEnergy, mathematicalHelmholtzFreeEnergy, partitionFunction, - Real.log_div hZ_pos.ne' h_pow_pos.ne'] - have h_log_pow : Real.log (𝓒.phaseSpaceunit ^ 𝓒.dof) - = (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - simp - simp [sub_eq_add_neg, h_log_pow, mul_add, add_comm, mul_comm, mul_left_comm, mul_assoc] + simp only [helmholtzFreeEnergy, mathematicalHelmholtzFreeEnergy, log_partitionFunction] + ring /-- General identity: S_diff = kB β ⟨E⟩ + kB log Z_math. This connects the differential entropy to the mean energy and the mathematical partition function. @@ -92,28 +86,15 @@ lemma differentialEntropy_eq_kB_beta_meanEnergy_add_kB_log_mathZ (hE : Integrable 𝓒.energy (𝓒.μProd T)) : 𝓒.differentialEntropy T = kB * (T.β : ℝ) * 𝓒.meanEnergy T + kB * Real.log (𝓒.mathematicalPartitionFunction T) := by - set Z := 𝓒.mathematicalPartitionFunction T - have hZpos := mathematicalPartitionFunction_pos 𝓒 T - have h_log_prob : ∀ i, Real.log (𝓒.probability T i) = - - (T.β : ℝ) * 𝓒.energy i - Real.log Z := by - intro i - have : 0 < Z := hZpos - rw [probability, Real.log_div (exp_pos _).ne' this.ne', Real.log_exp] - unfold differentialEntropy - rw [integral_congr_ae (ae_of_all _ h_log_prob)] - have h_split : - (fun i => - (T.β : ℝ) * 𝓒.energy i - Real.log Z) - = (fun i => (- (T.β : ℝ)) * 𝓒.energy i + (- Real.log Z)) := by - funext i; ring - simp_rw [h_split] - have h_int1 : Integrable (fun _ : ι => - Real.log Z) (𝓒.μProd T) := - (integrable_const _) - have h_intE : Integrable (fun i => (- (T.β : ℝ)) * 𝓒.energy i) (𝓒.μProd T) := - (hE.const_mul _) - rw [integral_add h_intE h_int1, - integral_const_mul, meanEnergy, integral_const] - simp [mul_add, add_comm, mul_comm, mul_left_comm, - mul_comm, mul_left_comm] + have h_log_prob : ∀ i, Real.log (𝓒.probability T i) + = -(T.β : ℝ) * 𝓒.energy i - Real.log (𝓒.mathematicalPartitionFunction T) := fun i => by + rw [probability, Real.log_div (Real.exp_pos _).ne' + (mathematicalPartitionFunction_pos 𝓒 T).ne', Real.log_exp] + simp only [differentialEntropy, meanEnergy] + rw [integral_congr_ae (ae_of_all _ h_log_prob), + integral_sub (hE.const_mul _) (integrable_const _), integral_const_mul, integral_const] + simp only [probReal_univ, smul_eq_mul] + ring /-- Pointwise logarithm of the Boltzmann probability. -/ lemma log_probability @@ -121,23 +102,18 @@ lemma log_probability [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] (i : ι) : Real.log (𝓒.probability T i) = - (β T) * 𝓒.energy i - Real.log (𝓒.mathematicalPartitionFunction T) := by - have hZpos := mathematicalPartitionFunction_pos (𝓒:=𝓒) (T:=T) - unfold probability - simp [Real.log_div, hZpos.ne', Real.log_exp, sub_eq_add_neg] + simp [probability, Real.log_div, (mathematicalPartitionFunction_pos (𝓒 := 𝓒) (T := T)).ne', + Real.log_exp, sub_eq_add_neg] /-- Auxiliary identity: `kB · β = 1 / T`. `β` is defined as `1 / (kB · T)` (see `Temperature.β`). -/ @[simp] lemma kB_mul_beta (T : Temperature) (hT : 0 < T.val) : (kB : ℝ) * (T.β : ℝ) = 1 / T.val := by - have hkB : (kB : ℝ) ≠ 0 := kB_ne_zero - have hT0 : (T.val : ℝ) ≠ 0 := by - exact_mod_cast (ne_of_gt hT) - simp [Temperature.β] - field_simp [Temperature.β, hkB, hT0, toReal] - rw [NNReal.toReal] - field_simp - simp [toReal, hT0] + have hT0 : (T.val : ℝ) ≠ 0 := by exact_mod_cast hT.ne' + unfold Temperature.β + change kB * (1 / (kB * (T.val : ℝ))) = 1 / (T.val : ℝ) + field_simp [kB_ne_zero, hT0] /-- Fundamental relation between thermodynamic and differential entropy: `S_thermo = S_diff - kB * dof * log h`. -/ @@ -148,62 +124,18 @@ lemma thermodynamicEntropy_eq_differentialEntropy_sub_correction 𝓒.thermodynamicEntropy T = 𝓒.differentialEntropy T - kB * 𝓒.dof * Real.log 𝓒.phaseSpaceunit := by - have hZpos := 𝓒.mathematicalPartitionFunction_pos (T:=T) - have h_log_prob_point : - ∀ i, Real.log (𝓒.probability T i) - = (- (T.β : ℝ)) * 𝓒.energy i - - Real.log (𝓒.mathematicalPartitionFunction T) := by - intro i - have : 0 < 𝓒.mathematicalPartitionFunction T := hZpos - unfold probability - simp [Real.log_div (Real.exp_pos _).ne' this.ne', Real.log_exp, sub_eq_add_neg] - have h_log_phys_pt : - ∀ i, Real.log (𝓒.physicalProbability T i) - = Real.log (𝓒.probability T i) - + (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := - 𝓒.log_physicalProbability (T:=T) - have h_int_log_prob : - Integrable (fun i => Real.log (𝓒.probability T i)) (𝓒.μProd T) := by - have h_intE : - Integrable (fun i => (- (T.β : ℝ)) * 𝓒.energy i) (𝓒.μProd T) := - hE.const_mul _ - have h_intC : - Integrable (fun _ : ι => - Real.log (𝓒.mathematicalPartitionFunction T)) - (𝓒.μProd T) := integrable_const _ - have h_eq : - (fun i => Real.log (𝓒.probability T i)) - = - (fun i => (- (T.β : ℝ)) * 𝓒.energy i - + (- Real.log (𝓒.mathematicalPartitionFunction T))) := by - funext i - simp [h_log_prob_point i, sub_eq_add_neg, add_comm] - simpa [h_eq] using h_intE.add h_intC - have h_int_const : - Integrable (fun _ : ι => - (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit) (𝓒.μProd T) := - integrable_const _ - have h_int_rewrite : - ∫ i, Real.log (𝓒.physicalProbability T i) ∂ 𝓒.μProd T - = - ∫ i, (Real.log (𝓒.probability T i) - + (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit) ∂ 𝓒.μProd T := by - simp_all only [neg_mul, physicalProbability_def] - have h_int_const_eval : - ∫ _i, (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit ∂ 𝓒.μProd T - = (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - simp [integral_const] - unfold thermodynamicEntropy differentialEntropy - rw [h_int_rewrite, - integral_add h_int_log_prob h_int_const, - h_int_const_eval] - have : -kB * - (∫ i, Real.log (𝓒.probability T i) ∂ 𝓒.μProd T + - (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit) - = - (-kB * ∫ i, Real.log (𝓒.probability T i) ∂ 𝓒.μProd T) - - kB * (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - ring - simp [this, sub_eq_add_neg, mul_assoc] + have h_int_log_prob : Integrable (fun i => Real.log (𝓒.probability T i)) (𝓒.μProd T) := by + have h_eq : (fun i => Real.log (𝓒.probability T i)) + = fun i => -(T.β : ℝ) * 𝓒.energy i + - Real.log (𝓒.mathematicalPartitionFunction T) := + funext fun i => 𝓒.log_probability T i + rw [h_eq] + exact (hE.const_mul _).sub (integrable_const _) + simp only [thermodynamicEntropy_def, differentialEntropy] + rw [integral_congr_ae (ae_of_all _ fun i => 𝓒.log_physicalProbability T i), + integral_add h_int_log_prob (integrable_const _), integral_const] + simp only [probReal_univ, smul_eq_mul] + ring /-- No semiclassical correction when `dof = 0`. -/ lemma thermodynamicEntropy_eq_differentialEntropy_of_dof_zero @@ -211,10 +143,8 @@ lemma thermodynamicEntropy_eq_differentialEntropy_of_dof_zero (h0 : 𝓒.dof = 0) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : 𝓒.thermodynamicEntropy T = 𝓒.differentialEntropy T := by - have h := - 𝓒.thermodynamicEntropy_eq_differentialEntropy_sub_correction - (T:=T) (hE:=hE) - simp_all + simpa [h0] using + 𝓒.thermodynamicEntropy_eq_differentialEntropy_sub_correction (T := T) hE /-- No semiclassical correction when `phase_space_unit = 1`. -/ lemma thermodynamicEntropy_eq_differentialEntropy_of_phase_space_unit_one @@ -222,10 +152,8 @@ lemma thermodynamicEntropy_eq_differentialEntropy_of_phase_space_unit_one (h1 : 𝓒.phaseSpaceunit = 1) [IsFiniteMeasure (𝓒.μBolt T)] [NeZero 𝓒.μ] : 𝓒.thermodynamicEntropy T = 𝓒.differentialEntropy T := by - have h' := - 𝓒.thermodynamicEntropy_eq_differentialEntropy_sub_correction - (T:=T) (hE:=hE) - simp_all + simpa [h1] using + 𝓒.thermodynamicEntropy_eq_differentialEntropy_sub_correction (T := T) hE /- ## Thermodynamic Identities @@ -248,13 +176,11 @@ theorem helmholtzFreeEnergy_eq_meanEnergy_sub_temp_mul_thermodynamicEntropy (hE : Integrable 𝓒.energy (𝓒.μProd T)) : 𝓒.helmholtzFreeEnergy T = 𝓒.meanEnergy T - T.val * 𝓒.thermodynamicEntropy T := by - have hZpos := 𝓒.mathematicalPartitionFunction_pos T - have hhpos : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ have hTne : (T.val : ℝ) ≠ 0 := by exact_mod_cast hT.ne' have hkβT : T.val * (kB * (T.β : ℝ)) = 1 := by rw [kB_mul_beta T hT, mul_one_div, div_self hTne] - rw [helmholtzFreeEnergy_def, partitionFunction_def, Real.log_div hZpos.ne' hhpos.ne', - Real.log_pow, 𝓒.thermodynamicEntropy_eq_differentialEntropy_sub_correction (T := T) hE, + rw [helmholtzFreeEnergy_def, log_partitionFunction, + 𝓒.thermodynamicEntropy_eq_differentialEntropy_sub_correction (T := T) hE, 𝓒.differentialEntropy_eq_kB_beta_meanEnergy_add_kB_log_mathZ (T := T) hE] linear_combination 𝓒.meanEnergy T * hkβT @@ -276,71 +202,11 @@ theorem differentialEntropy_eq_meanEnergy_sub_helmholtz_div_temp_add_correction 𝓒.differentialEntropy T = (𝓒.meanEnergy T - 𝓒.helmholtzFreeEnergy T) / T.val + kB * 𝓒.dof * Real.log 𝓒.phaseSpaceunit := by - have hS := - differentialEntropy_eq_kB_beta_meanEnergy_add_kB_log_mathZ (𝓒:=𝓒) (T:=T) hE - set E := 𝓒.meanEnergy T - set Zmath := 𝓒.mathematicalPartitionFunction T - set Zphys := 𝓒.partitionFunction T - have Tne : (T.val : ℝ) ≠ 0 := by exact_mod_cast (ne_of_gt hT) - have hkβ : kB * (T.β : ℝ) = 1 / (T.val : ℝ) := by - unfold Temperature.β - change kB * (1 / (kB * (T.val : ℝ))) = 1 / (T.val : ℝ) - field_simp [Constants.kB_ne_zero, Tne] - have hS' : - 𝓒.differentialEntropy T = E / T.val + kB * Real.log Zmath := by - rw [hS, hkβ] - simp [E, div_eq_mul_inv, mul_comm] - have hZdef : Zmath = Zphys * 𝓒.phaseSpaceunit ^ 𝓒.dof := by - unfold Zmath Zphys partitionFunction - have hne : (𝓒.phaseSpaceunit ^ 𝓒.dof) ≠ 0 := - pow_ne_zero _ (ne_of_gt 𝓒.hPos) - simp [div_eq_mul_inv, hne] - have hpow_pos : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ - have hZmath_pos : - 0 < Zmath := (mathematicalPartitionFunction_pos (𝓒:=𝓒) (T:=T)) - have hZphys_pos : - 0 < Zphys := by - have : Zphys = Zmath / 𝓒.phaseSpaceunit ^ 𝓒.dof := by - simp [Zphys, div_eq_mul_inv] - exact Or.symm (Or.inr rfl) - have hden_pos : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := hpow_pos - simp [this, hZmath_pos, hden_pos] - have hlog : - Real.log Zmath - = Real.log Zphys + (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - have hx : 0 < Zphys := hZphys_pos - have hy : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := hpow_pos - have hlog_pow : - Real.log (𝓒.phaseSpaceunit ^ 𝓒.dof) - = (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - simp - calc - Real.log Zmath - = Real.log (Zphys * 𝓒.phaseSpaceunit ^ 𝓒.dof) := by simp [hZdef] - _ = Real.log Zphys + Real.log (𝓒.phaseSpaceunit ^ 𝓒.dof) := by - have hx0 : Zphys ≠ 0 := ne_of_gt hx - have hy0 : 𝓒.phaseSpaceunit ^ 𝓒.dof ≠ 0 := ne_of_gt hy - simpa [mul_comm, mul_left_comm, mul_assoc] using (Real.log_mul hx0 hy0) - _ = Real.log Zphys + (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by simp [hlog_pow] - have hS_phys : - 𝓒.differentialEntropy T - = E / T.val + kB * Real.log Zphys - + kB * (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - rw [hS', hlog] - ring - have hEF : - (E - 𝓒.helmholtzFreeEnergy T) / T.val - = E / T.val + kB * Real.log Zphys := by - simp [sub_eq_add_neg, division_def, mul_add, - mul_comm, mul_left_comm, mul_assoc, E, Zphys, Tne] - calc - 𝓒.differentialEntropy T - = (E / T.val + kB * Real.log Zphys) - + kB * (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - simp [hS_phys, add_comm, add_left_comm] - _ = (E - 𝓒.helmholtzFreeEnergy T) / T.val - + kB * 𝓒.dof * Real.log 𝓒.phaseSpaceunit := by - rw [hEF] + have hTne : (T.val : ℝ) ≠ 0 := by exact_mod_cast hT.ne' + rw [differentialEntropy_eq_kB_beta_meanEnergy_add_kB_log_mathZ 𝓒 T hE, + helmholtzFreeEnergy_def, log_partitionFunction, kB_mul_beta T hT] + field_simp + ring /-- Discrete / normalized specialization of the previous theorem. If either `dof = 0` (no semiclassical correction) or `phaseSpaceUnit = 1` @@ -357,9 +223,7 @@ lemma differentialEntropy_eq_meanEnergy_sub_helmholtz_div_temp have hmain := differentialEntropy_eq_meanEnergy_sub_helmholtz_div_temp_add_correction (𝓒:=𝓒) (T:=T) hT hE - rcases hNorm with hDof | hUnit - · simp [hmain, hDof] - · simp [hmain, hUnit] + rcases hNorm with h | h <;> simp [hmain, h] /-- Chain rule convenience lemma for `log ∘ f` on a set. -/ lemma hasDerivWithinAt_log_comp @@ -374,8 +238,7 @@ lemma hasDerivWithinAt_log_comp' (hf : HasDerivWithinAt f f' s x) (hx : f x ≠ 0) : HasDerivWithinAt (fun t => Real.log (f t)) ((1 / f x) * f') s x := by - simpa [one_div, mul_comm, mul_left_comm, mul_assoc] - using (hasDerivWithinAt_log_comp (f:=f) (f':=f') (s:=s) (x:=x) hf hx) + simpa [one_div] using hasDerivWithinAt_log_comp hf hx lemma integral_bolt_eq_integral_mul_exp {ι} [MeasurableSpace ι] (𝓒 : CanonicalEnsemble ι) (T : Temperature) @@ -384,23 +247,10 @@ lemma integral_bolt_eq_integral_mul_exp = ∫ x, φ x * Real.exp (-T.β * 𝓒.energy x) ∂ 𝓒.μ := by unfold μBolt set f : ι → ℝ≥0∞ := fun x => ENNReal.ofReal (Real.exp (-T.β * 𝓒.energy x)) - have hf_meas : Measurable f := by - fun_prop - have hf_lt_top : ∀ᵐ x ∂ 𝓒.μ, f x < ∞ := by - simp [f] - have h := - integral_withDensity_eq_integral_toReal_smul - (μ := 𝓒.μ) hf_meas hf_lt_top φ - have h_toReal : ∀ x, (f x).toReal = Real.exp (-T.β * 𝓒.energy x) := by - intro x - have h_nonneg : (0 : ℝ) ≤ Real.exp (-T.β * 𝓒.energy x) := - (Real.exp_pos _).le - simpa [f, h_nonneg] using ENNReal.toReal_ofReal h_nonneg - have h' : - (∫ x, φ x ∂ 𝓒.μ.withDensity f) = - ∫ x, φ x * Real.exp (-T.β * 𝓒.energy x) ∂ 𝓒.μ := by - simpa [h_toReal, smul_eq_mul, mul_comm] using h - simpa [f, mul_comm] using h' + have hf_meas : Measurable f := by fun_prop + have hf_lt_top : ∀ᵐ x ∂ 𝓒.μ, f x < ∞ := by simp [f] + have h := integral_withDensity_eq_integral_toReal_smul (μ := 𝓒.μ) hf_meas hf_lt_top φ + simpa [f, ENNReal.toReal_ofReal, Real.exp_nonneg, smul_eq_mul, mul_comm] using h set_option linter.unusedVariables false in /-- A specialization of `integral_bolt_eq_integral_mul_exp` @@ -408,8 +258,8 @@ to the energy observable. -/ lemma integral_energy_bolt {ι} [MeasurableSpace ι] (𝓒 : CanonicalEnsemble ι) (T : Temperature) : ∫ x, 𝓒.energy x ∂ 𝓒.μBolt T - = ∫ x, 𝓒.energy x * Real.exp (-T.β * 𝓒.energy x) ∂ 𝓒.μ := by - exact integral_bolt_eq_integral_mul_exp 𝓒 T 𝓒.energy + = ∫ x, 𝓒.energy x * Real.exp (-T.β * 𝓒.energy x) ∂ 𝓒.μ := + integral_bolt_eq_integral_mul_exp 𝓒 T 𝓒.energy /-- The mean energy can be expressed as a ratio of integrals. -/ lemma meanEnergy_eq_ratio_of_integrals @@ -418,32 +268,10 @@ lemma meanEnergy_eq_ratio_of_integrals (∫ i, 𝓒.energy i * Real.exp (- T.β * 𝓒.energy i) ∂ 𝓒.μ) / (∫ i, Real.exp (- T.β * 𝓒.energy i) ∂ 𝓒.μ) := by unfold meanEnergy μProd - have h_scale : - ∫ x, 𝓒.energy x ∂ ((𝓒.μBolt T Set.univ)⁻¹ • 𝓒.μBolt T) - = ((𝓒.μBolt T Set.univ)⁻¹).toReal * ∫ x, 𝓒.energy x ∂ 𝓒.μBolt T := by - simp - have h_energy_bolt_raw := - integral_energy_bolt (𝓒:=𝓒) (T:=T) - have h_den : - (𝓒.μBolt T Set.univ).toReal - = ∫ x, Real.exp (- T.β * 𝓒.energy x) ∂ 𝓒.μ := by - exact (mathematicalPartitionFunction_eq_integral (𝓒:=𝓒) (T:=T)) - have h_inv_toReal : - ((𝓒.μBolt T Set.univ)⁻¹).toReal - = 1 / (𝓒.μBolt T Set.univ).toReal := by - simp [one_div, ENNReal.toReal_inv] - calc - ∫ x, 𝓒.energy x ∂ ((𝓒.μBolt T Set.univ)⁻¹ • 𝓒.μBolt T) - = ((𝓒.μBolt T Set.univ)⁻¹).toReal * ∫ x, 𝓒.energy x ∂ 𝓒.μBolt T := h_scale - _ = ((𝓒.μBolt T Set.univ)⁻¹).toReal * - (∫ x, 𝓒.energy x * Real.exp (- T.β * 𝓒.energy x) ∂ 𝓒.μ) := by - simp [h_energy_bolt_raw] - _ = (1 / (𝓒.μBolt T Set.univ).toReal) * - (∫ x, 𝓒.energy x * Real.exp (- T.β * 𝓒.energy x) ∂ 𝓒.μ) := by - simp [h_inv_toReal] - _ = (∫ x, 𝓒.energy x * Real.exp (- T.β * 𝓒.energy x) ∂ 𝓒.μ) / - (∫ x, Real.exp (- T.β * 𝓒.energy x) ∂ 𝓒.μ) := by - simp [h_den, div_eq_mul_inv, mul_comm] + have h_den : (𝓒.μBolt T Set.univ).toReal = ∫ x, Real.exp (- T.β * 𝓒.energy x) ∂ 𝓒.μ := + mathematicalPartitionFunction_eq_integral (𝓒 := 𝓒) (T := T) + rw [integral_smul_measure, smul_eq_mul, integral_energy_bolt, ENNReal.toReal_inv, h_den] + ring /-- The mean energy is the negative derivative of the logarithm of the (mathematical) partition function with respect to β = 1/(kB T). @@ -465,52 +293,17 @@ lemma meanEnergy_eq_neg_deriv_log_mathZ_of_beta set f : ℝ → ℝ := fun β => ∫ i, Real.exp (-β * 𝓒.energy i) ∂𝓒.μ have hβ_pos : 0 < (T.β : ℝ) := beta_pos T hT_pos have hZpos : 0 < f (T.β : ℝ) := by - have hZ := mathematicalPartitionFunction_pos (𝓒:=𝓒) (T:=T) - have hEq : f (T.β : ℝ) = 𝓒.mathematicalPartitionFunction T := by - simp [f, mathematicalPartitionFunction_eq_integral (𝓒:=𝓒) (T:=T)] - simpa [hEq] using hZ - have h_log : - HasDerivWithinAt - (fun β : ℝ => Real.log (f β)) - ((1 / f (T.β : ℝ)) * - (- ∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ)) - (Set.Ioi 0) (T.β : ℝ) := by - have h₁ := - CanonicalEnsemble.hasDerivWithinAt_log_comp' - (hf := h_deriv) (hx := (ne_of_gt hZpos)) - simpa [f] using h₁ - have h_mean_ratio : - 𝓒.meanEnergy T = - (∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) / - (∫ i, Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) := by - simpa [neg_mul, mul_comm, mul_left_comm, mul_assoc] - using meanEnergy_eq_ratio_of_integrals (𝓒:=𝓒) (T:=T) - have h_mem : (T.β : ℝ) ∈ Set.Ioi (0:ℝ) := hβ_pos + simpa [f, mathematicalPartitionFunction_eq_integral (𝓒 := 𝓒) (T := T)] + using mathematicalPartitionFunction_pos (𝓒 := 𝓒) (T := T) + have h_log : HasDerivWithinAt (fun β : ℝ => Real.log (f β)) + ((1 / f (T.β : ℝ)) * (- ∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ)) + (Set.Ioi 0) (T.β : ℝ) := by + simpa [f] using hasDerivWithinAt_log_comp' (hf := h_deriv) (hx := hZpos.ne') have hUD : UniqueDiffWithinAt ℝ (Set.Ioi (0:ℝ)) (T.β : ℝ) := - isOpen_Ioi.uniqueDiffWithinAt h_mem - have h_deriv_log : - derivWithin (fun β : ℝ => Real.log (f β)) (Set.Ioi 0) (T.β : ℝ) - = (1 / f (T.β : ℝ)) * - (- ∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) := - h_log.derivWithin hUD - have h_f_eval : - f (T.β : ℝ) = ∫ i, Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ := rfl - have h_ratio : - (∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) / - (∫ i, Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) - = (1 / f (T.β : ℝ)) * - (∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) := by - simp [h_f_eval, div_eq_mul_inv, mul_comm] - calc - 𝓒.meanEnergy T = _ := h_mean_ratio - _ = (1 / f (T.β : ℝ)) * - (∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ) := h_ratio - _ = - ((1 / f (T.β : ℝ)) * - (- ∫ i, 𝓒.energy i * Real.exp (-(T.β : ℝ) * 𝓒.energy i) ∂𝓒.μ)) := by ring - _ = - (derivWithin - (fun β : ℝ => Real.log (∫ i, Real.exp (-β * 𝓒.energy i) ∂𝓒.μ)) - (Set.Ioi 0) (T.β : ℝ)) := by - rw [h_deriv_log] + isOpen_Ioi.uniqueDiffWithinAt hβ_pos + rw [meanEnergy_eq_ratio_of_integrals, h_log.derivWithin hUD] + simp only [f] + ring section Ratios @@ -538,42 +331,10 @@ lemma log_phys_eq_log_math_sub_const_on_Ioi (Set.Ioi (0 : ℝ)) := by intro β hβ have hβpos : 0 < β := hβ - have hβnn : Real.toNNReal β = β := by - simp [Real.toNNReal, hβpos.le] have _inst : IsFiniteMeasure (𝓒.μBolt (Temperature.ofβ (Real.toNNReal β))) := h_fin β hβpos - have hZpos : - 0 < 𝓒.mathematicalPartitionFunction (Temperature.ofβ (Real.toNNReal β)) := by - simpa [hβnn] using - (mathematicalPartitionFunction_pos (𝓒:=𝓒) - (T:=Temperature.ofβ (Real.toNNReal β))) - have h_pow_pos : 0 < 𝓒.phaseSpaceunit ^ 𝓒.dof := pow_pos 𝓒.hPos _ - have h_log_pow : - Real.log (𝓒.phaseSpaceunit ^ 𝓒.dof) - = (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit := by - simp - have : - Real.log (𝓒.partitionFunction (Temperature.ofβ (Real.toNNReal β))) = - -((𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit) - + Real.log (∫ i, Real.exp (-β * 𝓒.energy i) ∂ 𝓒.μ) := by - have h_integral_pos : 0 < ∫ i, Real.exp (-β * 𝓒.energy i) ∂ 𝓒.μ := by - have h_eq : ∫ i, Real.exp (-β * 𝓒.energy i) ∂ 𝓒.μ = - ∫ i, Real.exp (-(Real.toNNReal β).val * 𝓒.energy i) ∂ 𝓒.μ := by - simp [hβnn] - rw [h_eq] - simp [mathematicalPartitionFunction_eq_integral - (𝓒:=𝓒) (T:=Temperature.ofβ (Real.toNNReal β))] at hZpos - simp [hZpos] - have h_beta_eq : (Temperature.ofβ (Real.toNNReal β)).β = Real.toNNReal β := by - simp_all only [gt_iff_lt, mem_Ioi, coe_toNNReal', sup_eq_left, log_pow, neg_mul, β_ofβ] - rw [partitionFunction_def, - mathematicalPartitionFunction_eq_integral (𝓒:=𝓒) (T:=Temperature.ofβ (Real.toNNReal β)), - h_beta_eq, - hβnn, - Real.log_div h_integral_pos.ne' h_pow_pos.ne', - h_log_pow] - ring - simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using this + simp only [log_partitionFunction, log_mathematicalPartitionFunction_eq, β_ofβ, + Real.coe_toNNReal β hβpos.le] /-- Derivative equality needed in `meanEnergy_eq_neg_deriv_log_Z_of_beta`. Adds `h_fin` (finiteness of the Boltzmann measure for every β > 0). -/ @@ -590,36 +351,8 @@ lemma derivWithin_log_phys_eq_derivWithin_log_math derivWithin (fun β : ℝ => Real.log (∫ i, Real.exp (-β * 𝓒.energy i) ∂ 𝓒.μ)) (Set.Ioi 0) (T.β : ℝ) := by - classical - set C : ℝ := (𝓒.dof : ℝ) * Real.log 𝓒.phaseSpaceunit - have h_eq : - Set.EqOn - (fun β : ℝ => - Real.log (𝓒.partitionFunction (ofβ (Real.toNNReal β)))) - (fun β : ℝ => - Real.log (∫ i, Real.exp (-β * 𝓒.energy i) ∂ 𝓒.μ) - C) - (Set.Ioi (0:ℝ)) := - log_phys_eq_log_math_sub_const_on_Ioi (𝓒:=𝓒) (h_fin:=h_fin) - set F_phys := - fun β : ℝ => Real.log (𝓒.partitionFunction (ofβ (Real.toNNReal β))) with hF_phys - set F_math := - fun β : ℝ => - Real.log (∫ i, Real.exp (-β * 𝓒.energy i) ∂ 𝓒.μ) with hF_math - have h_eq' : - Set.EqOn F_phys (fun β => F_math β - C) (Set.Ioi (0:ℝ)) := by - simpa [F_phys, F_math] using h_eq - have h_mem : (T.β : ℝ) ∈ Set.Ioi (0:ℝ) := beta_pos T hT_pos - have h_congr : - derivWithin F_phys (Set.Ioi 0) (T.β : ℝ) - = derivWithin (fun β => F_math β - C) (Set.Ioi 0) (T.β : ℝ) := by - apply derivWithin_congr - · exact h_eq - · exact h_eq h_mem - have h_sub : - derivWithin (fun β => F_math β - C) (Set.Ioi 0) (T.β : ℝ) - = derivWithin F_math (Set.Ioi 0) (T.β : ℝ) := by - simp [F_math, sub_eq_add_neg]; rw [@derivWithin_add_const] - simpa [F_phys, F_math] using h_congr.trans h_sub + have h_eq := log_phys_eq_log_math_sub_const_on_Ioi (𝓒 := 𝓒) (h_fin := h_fin) + rw [derivWithin_congr h_eq (h_eq (beta_pos T hT_pos)), derivWithin_sub_const] /-- The mean energy can also be expressed as the negative derivative of the logarithm of the *physical* partition function with respect to β. This follows from the fact that the physical and @@ -640,12 +373,8 @@ theorem meanEnergy_eq_neg_deriv_log_Z_of_beta - (derivWithin (fun β : ℝ => Real.log (𝓒.partitionFunction (ofβ (Real.toNNReal β)))) (Set.Ioi 0) (T.β : ℝ)) := by - have h_math := - 𝓒.meanEnergy_eq_neg_deriv_log_mathZ_of_beta T hT_pos h_deriv - have h_dw := - derivWithin_log_phys_eq_derivWithin_log_math - (𝓒:=𝓒) (T:=T) hT_pos h_fin - rw [h_dw]; exact h_math + rw [derivWithin_log_phys_eq_derivWithin_log_math (𝓒 := 𝓒) (T := T) hT_pos h_fin] + exact 𝓒.meanEnergy_eq_neg_deriv_log_mathZ_of_beta T hT_pos h_deriv end Ratios @@ -659,33 +388,18 @@ theorem energyVariance_eq_meanSquareEnergy_sub_meanEnergy_sq (hE_int : Integrable 𝓒.energy (𝓒.μProd T)) (hE2_int : Integrable (fun i => (𝓒.energy i)^2) (𝓒.μProd T)) : 𝓒.energyVariance T = 𝓒.meanSquareEnergy T - (𝓒.meanEnergy T)^2 := by - -- same proof as before unfold energyVariance meanSquareEnergy meanEnergy - set U := ∫ i, 𝓒.energy i ∂𝓒.μProd T + set U := ∫ i, 𝓒.energy i ∂𝓒.μProd T with hU have h_expand : (fun i => (𝓒.energy i - U)^2) = (fun i => (𝓒.energy i)^2 - 2 * U * 𝓒.energy i + U^2) := by funext i; ring - rw [h_expand] have h_int_E_mul_const : Integrable (fun i => 2 * U * 𝓒.energy i) (𝓒.μProd T) := hE_int.const_mul (2 * U) - have h_int_const : Integrable (fun _ => U^2) (𝓒.μProd T) := integrable_const _ - erw [integral_add (hE2_int.sub h_int_E_mul_const) h_int_const] + rw [h_expand] + erw [integral_add (hE2_int.sub h_int_E_mul_const) (integrable_const _)] erw [integral_sub hE2_int h_int_E_mul_const] - rw [integral_const_mul] - rw [integral_const] - have hμProb : (𝓒.μProd T) Set.univ = 1 := by simp - have hμReal : (𝓒.μProd T).real Set.univ = 1 := by - simp [measureReal_def, hμProb] - calc - ∫ i, (𝓒.energy i)^2 ∂𝓒.μProd T - - 2 * U * ∫ i, 𝓒.energy i ∂𝓒.μProd T - + (𝓒.μProd T).real Set.univ * U^2 - = ∫ i, (𝓒.energy i)^2 ∂𝓒.μProd T - 2 * U * U + (𝓒.μProd T).real Set.univ * U^2 := by - simp [U] - _ = ∫ i, (𝓒.energy i)^2 ∂𝓒.μProd T - 2 * U^2 + (𝓒.μProd T).real Set.univ * U^2 := by ring - _ = ∫ i, (𝓒.energy i)^2 ∂𝓒.μProd T - U^2 := by - simp [hμReal, sub_eq_add_neg, add_comm, mul_comm] - ring_nf + rw [integral_const_mul, integral_const, ← hU, probReal_univ, smul_eq_mul] + ring /-! ## Heat capacity and parametric FDT -/ @@ -713,20 +427,14 @@ lemma heatCapacity_eq_deriv_meanEnergyBeta 𝓒.heatCapacity T = (derivWithin (𝓒.meanEnergyBeta) (Set.Ioi 0) (T.β : ℝ)) * (-1 / (kB * (T.val : ℝ)^2)) := by - unfold heatCapacity meanEnergy_T have h_U_eq_comp : (𝓒.meanEnergy_T) = fun t : ℝ => (𝓒.meanEnergyBeta) (betaFromReal t) := by funext t - dsimp [meanEnergy_T, meanEnergyBeta, betaFromReal] - simp - let dUdβ := derivWithin (𝓒.meanEnergyBeta) (Set.Ioi 0) (T.β : ℝ) - have h_chain := chain_rule_T_beta (F:=𝓒.meanEnergyBeta) (F':=dUdβ) T hT_pos hU_deriv - have h_UD : - UniqueDiffWithinAt ℝ (Set.Ioi (0 : ℝ)) (T.val : ℝ) := - (isOpen_Ioi : IsOpen (Set.Ioi (0 : ℝ))).uniqueDiffWithinAt hT_pos - simp only [ofNNReal] - rw [← (h_chain.derivWithin h_UD)] - ring_nf - simp_rw [← h_U_eq_comp]; rfl + simp [meanEnergy_T, meanEnergyBeta, betaFromReal] + have h_UD : UniqueDiffWithinAt ℝ (Set.Ioi (0 : ℝ)) (T.val : ℝ) := + isOpen_Ioi.uniqueDiffWithinAt hT_pos + unfold heatCapacity + rw [h_U_eq_comp] + exact (chain_rule_T_beta (F := 𝓒.meanEnergyBeta) T hT_pos hU_deriv).derivWithin h_UD /-- Parametric FDT: C_V = Var(E)/(kB T²), assuming Var(E) = - dU/dβ. -/ theorem fluctuation_dissipation_energy_parametric @@ -736,13 +444,8 @@ theorem fluctuation_dissipation_energy_parametric (hU_deriv : DifferentiableWithinAt ℝ (𝓒.meanEnergyBeta) (Set.Ioi 0) (T.β : ℝ)) : 𝓒.heatCapacity T = 𝓒.energyVariance T / (kB * (T.val : ℝ)^2) := by - let dUdβ := derivWithin (𝓒.meanEnergyBeta) (Set.Ioi 0) (T.β : ℝ) - have hCV_eq_dUdβ_mul : - 𝓒.heatCapacity T = dUdβ * (-1 / (kB * (T.val : ℝ)^2)) := - heatCapacity_eq_deriv_meanEnergyBeta 𝓒 T hT_pos hU_deriv.hasDerivWithinAt - rw [hCV_eq_dUdβ_mul, h_Var_eq_neg_dUdβ] - have hkB_ne_zero := kB_ne_zero - field_simp [hkB_ne_zero, pow_ne_zero 2] + rw [heatCapacity_eq_deriv_meanEnergyBeta 𝓒 T hT_pos hU_deriv.hasDerivWithinAt, + h_Var_eq_neg_dUdβ] ring end CanonicalEnsemble diff --git a/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/ThermoQuantities.lean b/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/ThermoQuantities.lean index 7df6cf343..f69f702fb 100644 --- a/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/ThermoQuantities.lean +++ b/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/ThermoQuantities.lean @@ -56,8 +56,8 @@ private theorem partitionZ_eq_re_partitionZComplex {β : ℝ} by_cases h : H.H config = ⊤ · simp [h] · simp only [h, dite_false] - set e : ℝ := (H.H config).untop h - simpa [Complex.ofReal_mul] using (Complex.exp_ofReal_re (-(β * e))).symm + simpa [Complex.ofReal_mul] using + (Complex.exp_ofReal_re (-(β * (H.H config).untop h))).symm _ = RCLike.re (∫ x, ComplexLaplaceIntegrand (fun config : H.dim d → ℝ => H.H config) (β : ℂ) x) := integral_re hInt @@ -69,8 +69,8 @@ theorem contDiffAt_partitionZ_of_mem_interior_convergenceDomain {β : ℝ} (E := fun config : H.dim d → ℝ => H.H config) (H.measurable_H d) hβ).contDiffAt |>.real_of_complex |>.congr_of_eventuallyEq ?_ filter_upwards [(Complex.continuous_ofReal.tendsto β).eventually - (IsOpen.mem_nhds isOpen_interior hβ)] with x hx - exact H.partitionZ_eq_re_partitionZComplex d (_root_.interior_subset hx) + (IsOpen.mem_nhds isOpen_interior hβ)] with x hx using + H.partitionZ_eq_re_partitionZComplex d (_root_.interior_subset hx) /-- The partition function as a function of temperature T instead of β. -/ def partitionZT (T : ℝ) : ℝ := @@ -172,26 +172,20 @@ theorem β_eq_deriv_S_U {β : ℝ} β = (deriv (H.entropySβ d) β) / deriv (H.internalU d) β := by have hZ : ContDiffAt ℝ ⊤ (H.partitionZ d) β := H.contDiffAt_partitionZ_of_mem_interior_convergenceDomain d hZint - unfold entropySβ - unfold internalU + unfold entropySβ internalU --Show the differentiability side-goals - have hlogDiff : DifferentiableAt ℝ (fun β => Real.log (H.partitionZ d β)) β := by - have := hZne - have := hZ.differentiableAt (by simp) - fun_prop (disch := assumption) + have hlogDiff : DifferentiableAt ℝ (fun β => Real.log (H.partitionZ d β)) β := + (hZ.differentiableAt (by simp)).log hZne have hlogDerivDiff : DifferentiableAt ℝ (deriv fun β => Real.log (H.partitionZ d β)) β := by - have this := hZ.log hZne - replace this := - (this.fderiv_right (m := ⊤) (OrderTop.le_top _)).differentiableAt (by simp) + have := ((hZ.log hZne).fderiv_right (m := ⊤) (OrderTop.le_top _)).differentiableAt (by simp) unfold deriv fun_prop have hderiv : deriv (deriv fun β => Real.log (H.partitionZ d β)) β ≠ 0 := by intro hzero apply hU' change deriv (-fun β => deriv (fun β' => Real.log (H.partitionZ d β')) β) β = 0 - rw [deriv.neg] - simp [hzero] + simp [deriv.neg, hzero] --Main goal simp only [mul_neg] diff --git a/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean b/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean index 6ecee8545..3dab14bab 100644 --- a/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean +++ b/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean @@ -88,19 +88,14 @@ variable {𝓩 𝓩1 : Type} [DecidableEq 𝓩1] [DecidableEq 𝓩][CommRing lemma isAnomalyFree_map (f : 𝓩 →+* 𝓩1) {c : ChargeSpectrum 𝓩} (h : IsAnomalyFree c) : IsAnomalyFree (c.map (f.toAddMonoidHom)) := by - obtain ⟨Q, h1, h2⟩ := h - match Q with - | ⟨qHd, qHu, F5, F10⟩ => + obtain ⟨⟨qHd, qHu, F5, F10⟩, h1, h2⟩ := h let QM : Quanta 𝓩1 := ⟨Option.map f qHd, Option.map f qHu, F5.map fun y => (f y.1, y.2), F10.map fun y => (f y.1, y.2)⟩ - use QM.reduce - constructor - · rw [Quanta.mem_liftCharge_iff] at ⊢ h1 - simp [Quanta.reduce, QM] at ⊢ h1 + refine ⟨QM.reduce, ?_, ?_⟩ + · simp [Quanta.mem_liftCharge_iff, Quanta.reduce, QM] at ⊢ h1 refine ⟨?_, ?_, FiveQuanta.map_liftCharge _ _ _ h1.2.2.1, - TenQuanta.map_liftCharge _ _ _ h1.2.2.2⟩ - · simp [ChargeSpectrum.map, h1.1] - · simp [ChargeSpectrum.map, h1.2] + TenQuanta.map_liftCharge _ _ _ h1.2.2.2⟩ <;> + simp [ChargeSpectrum.map, h1] · rw [Quanta.LinearAnomalyCancellation] at h2 simp [QM, ← map_add, h2, Quanta.reduce, Quanta.LinearAnomalyCancellation, FiveQuanta.anomalyCoefficient_of_reduce, TenQuanta.anomalyCoefficient_of_reduce] diff --git a/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean b/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean index 0149297e8..4b8e0e436 100644 --- a/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean +++ b/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean @@ -95,9 +95,7 @@ namespace CodimensionOneConfig instance : Fintype CodimensionOneConfig where elems := {same, nearestNeighbor, nextToNearestNeighbor} - complete := by - intro I - cases I <;> decide + complete := by rintro (_ | _ | _) <;> decide /-! diff --git a/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean b/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean index b9a90ad86..0b4810041 100644 --- a/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean +++ b/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean @@ -447,8 +447,7 @@ lemma viableCharges_mem_ofFinset (I : CodimensionOneConfig) : -/ lemma isComplete_of_mem_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCharges I), IsComplete x := by - revert I - decide + decide +revert /-! @@ -458,8 +457,7 @@ lemma isComplete_of_mem_viableCharges (I : CodimensionOneConfig) : lemma allowsTerm_topYukawa_of_mem_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCharges I), x.AllowsTerm topYukawa := by - revert I - decide + decide +revert /-! @@ -469,12 +467,10 @@ lemma allowsTerm_topYukawa_of_mem_viableCharges (I : CodimensionOneConfig) : lemma not_isPhenoConstrained_of_mem_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCharges I), ¬ IsPhenoConstrained x := by - rw [viableCharges] - intro x hs - simp at hs - rcases hs with hs | hs - · exact viableCompletions_isPhenoConstrained I x hs - · exact not_isPhenoConstrained_of_mem_viableChargesAdditional I x hs + intro x hx + rw [viableCharges, Multiset.mem_add] at hx + exact hx.elim (viableCompletions_isPhenoConstrained I x) + (not_isPhenoConstrained_of_mem_viableChargesAdditional I x) /-! @@ -485,12 +481,10 @@ lemma not_isPhenoConstrained_of_mem_viableCharges (I : CodimensionOneConfig) : lemma not_yukawaGeneratesDangerousAtLevel_one_of_mem_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCharges I), ¬ YukawaGeneratesDangerousAtLevel x 1 := by - rw [viableCharges] - intro x hs - simp at hs - rcases hs with hs | hs - · exact viableCompletions_yukawaGeneratesDangerousAtLevel_one I x hs - · exact yukawaGeneratesDangerousAtLevel_one_of_mem_viableChargesAdditional I x hs + intro x hx + rw [viableCharges, Multiset.mem_add] at hx + exact hx.elim (viableCompletions_yukawaGeneratesDangerousAtLevel_one I x) + (yukawaGeneratesDangerousAtLevel_one_of_mem_viableChargesAdditional I x) /-! @@ -500,8 +494,7 @@ lemma not_yukawaGeneratesDangerousAtLevel_one_of_mem_viableCharges lemma card_five_bar_le_of_mem_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCharges I), x.Q5.card ≤ 2 := by - revert I - decide + decide +revert /-! @@ -511,8 +504,7 @@ lemma card_five_bar_le_of_mem_viableCharges (I : CodimensionOneConfig) : lemma card_ten_le_of_mem_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCharges I), x.Q10.card ≤ 2 := by - revert I - decide + decide +revert /-! @@ -530,8 +522,7 @@ couplings, or is already in `viableCharges I`. with the Yukawas. -/ lemma isPhenoClosedQ5_viableCharges : (I : CodimensionOneConfig) → IsPhenoClosedQ5 I.allowedBarFiveCharges (viableCharges I) := by - intro I - apply isPhenClosedQ5_of_isPhenoConstrainedQ5 + refine fun I => isPhenClosedQ5_of_isPhenoConstrainedQ5 ?_ revert I decide +kernel @@ -547,8 +538,7 @@ lemma isPhenoClosedQ5_viableCharges : (I : CodimensionOneConfig) → with the Yukawas. -/ lemma isPhenoClosedQ10_viableCharges : (I : CodimensionOneConfig) → IsPhenoClosedQ10 I.allowedTenCharges (viableCharges I) := by - intro I - apply isPhenClosedQ10_of_isPhenoConstrainedQ10 + refine fun I => isPhenClosedQ10_of_isPhenoConstrainedQ10 ?_ revert I decide +kernel @@ -560,11 +550,9 @@ lemma isPhenoClosedQ10_viableCharges : (I : CodimensionOneConfig) → lemma viableCompletions_subset_viableCharges (I : CodimensionOneConfig) : ∀ x ∈ (viableCompletions I), x ∈ viableCharges I := by - rw [viableCharges] intro x hx - simp only [Multiset.mem_add] - left - exact hx + rw [viableCharges, Multiset.mem_add] + exact Or.inl hx /-! @@ -595,13 +583,10 @@ lemma mem_viableCharges_iff' {I} {x : ChargeSpectrum} : ¬ IsPhenoConstrained x ∧ ¬ YukawaGeneratesDangerousAtLevel x 1 ∧ IsComplete x := by constructor · intro h - have h1 : x ∈ ofFinset I.allowedBarFiveCharges I.allowedTenCharges := by - exact viableCharges_mem_ofFinset I x h - rw [mem_viableCharges_iff h1] at h - exact ⟨h1, h⟩ + have h1 := viableCharges_mem_ofFinset I x h + exact ⟨h1, (mem_viableCharges_iff h1).mp h⟩ · rintro ⟨h1, h⟩ - rw [mem_viableCharges_iff h1] - exact h + exact (mem_viableCharges_iff h1).mpr h end ChargeSpectrum diff --git a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean index 07bbdb361..1f6da927a 100644 --- a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean +++ b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean @@ -184,10 +184,7 @@ lemma map_sum_add_of_mem_powerset_elemsNoExotics (F S : FluxesFive) (hS: S ∈ Multiset.powerset F) : (S.map (fun x => ⟨|x.1|, -|x.1|⟩)).sum + (S.map (fun x => ⟨(0 : ℤ), |x.1 + x.2|⟩)).sum = S.sum := by - fin_cases hf - all_goals - · fin_cases hS - all_goals decide + fin_cases hf <;> fin_cases hS <;> decide end FluxesFive diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean index 97f55e8ae..a521686ce 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean @@ -174,16 +174,12 @@ lemma mem_liftCharge_iff [DecidableEq 𝓩] {c : ChargeSpectrum 𝓩} {x : Quanta 𝓩} : x ∈ liftCharge c ↔ x.qHd = c.qHd ∧ x.qHu = c.qHu ∧ x.F ∈ FiveQuanta.liftCharge c.Q5 ∧ x.T ∈ TenQuanta.liftCharge c.Q10:= by - simp [liftCharge, Multiset.mem_bind, Multiset.mem_map] + simp only [liftCharge, Multiset.mem_bind, Multiset.mem_map] constructor · rintro ⟨Q5, h1, Q10, h2, rfl⟩ - simp_all - · intro h - use x.F - simp_all - use x.T - simp_all - rw [← h.1, ← h.2.1] + exact ⟨rfl, rfl, h1, h2⟩ + · rintro ⟨h1, h2, h3, h4⟩ + exact ⟨x.F, h3, x.T, h4, by rw [← h1, ← h2]⟩ /-! @@ -195,15 +191,10 @@ lemma toCharges_of_mem_liftCharge [DecidableEq 𝓩] {c : ChargeSpectrum 𝓩} {x : Quanta 𝓩} (h : x ∈ liftCharge c) : x.toCharges = c := by rw [mem_liftCharge_iff] at h - apply ChargeSpectrum.eq_of_parts - · simp_all [toCharges_qHd] - · simp_all [toCharges_qHu] - · have h1 := h.2.2.1 - rw [FiveQuanta.mem_liftCharge_iff] at h1 - simpa [toCharges] using h1.2.1 - · have h2 := h.2.2.2 - rw [TenQuanta.mem_liftCharge_iff] at h2 - simpa [toCharges] using h2.2.1 + obtain ⟨h1, h2, h3, h4⟩ := h + rw [FiveQuanta.mem_liftCharge_iff] at h3 + rw [TenQuanta.mem_liftCharge_iff] at h4 + exact ChargeSpectrum.eq_of_parts h1 h2 h3.2.1 h4.2.1 /-! @@ -238,9 +229,7 @@ def HdAnomalyCoefficient [CommRing 𝓩] (qHd : Option 𝓩) : 𝓩 × 𝓩 := lemma HdAnomalyCoefficient_map {𝓩 𝓩1 : Type} [CommRing 𝓩] [CommRing 𝓩1] (f : 𝓩 →+* 𝓩1) (qHd : Option 𝓩) : HdAnomalyCoefficient (qHd.map f) = (f.prodMap f) (HdAnomalyCoefficient qHd) := by - match qHd with - | none => simp [HdAnomalyCoefficient] - | some qHd => simp [HdAnomalyCoefficient] + cases qHd <;> simp [HdAnomalyCoefficient] /-! @@ -258,9 +247,7 @@ def HuAnomalyCoefficient [CommRing 𝓩] (qHu : Option 𝓩) : 𝓩 × 𝓩 := lemma HuAnomalyCoefficient_map {𝓩 𝓩1 : Type} [CommRing 𝓩] [CommRing 𝓩1] (f : 𝓩 →+* 𝓩1) (qHu : Option 𝓩) : HuAnomalyCoefficient (qHu.map f) = (f.prodMap f) (HuAnomalyCoefficient qHu) := by - match qHu with - | none => simp [HuAnomalyCoefficient] - | some qHu => simp [HuAnomalyCoefficient] + cases qHu <;> simp [HuAnomalyCoefficient] /-! diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean index 69f125ad4..f8b8d6c72 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean @@ -162,8 +162,7 @@ def reduce (x : FiveQuanta 𝓩) : FiveQuanta 𝓩 := lemma reduce_nodup (x : FiveQuanta 𝓩) : x.reduce.Nodup := by rw [reduce] - refine Multiset.Nodup.map (fun q1 q2 h => ?_) (Multiset.nodup_dedup x.toCharges) - exact congrArg Prod.fst h + exact Multiset.Nodup.map (fun _ _ h => congrArg Prod.fst h) (Multiset.nodup_dedup x.toCharges) @[simp] lemma reduce_dedup (x : FiveQuanta 𝓩) : x.reduce.dedup = x.reduce := @@ -188,15 +187,7 @@ lemma mem_reduce_iff (x : FiveQuanta 𝓩) (p : 𝓩 × Fluxes) : p ∈ x.reduce ↔ p.1 ∈ x.toCharges ∧ p.2 = ((x.filter (fun f => f.1 = p.1)).map (fun y => y.2)).sum := by simp [reduce] - constructor - · intro h - obtain ⟨q, h1, rfl⟩ := h - simp_all - · simp - intro h1 h2 - use p.1 - simp_all - rw [← h2] + aesop /-! @@ -207,13 +198,7 @@ lemma mem_reduce_iff (x : FiveQuanta 𝓩) (p : 𝓩 × Fluxes) : lemma reduce_filter (x : FiveQuanta 𝓩) (q : 𝓩) (h : q ∈ x.toCharges) : x.reduce.filter (fun f => f.1 = q) = {(q, ((x.filter (fun f => f.1 = q)).map (fun y => y.2)).sum)} := by - simp [reduce] - rw [Multiset.filter_map] - simp only [Function.comp_apply] - have hx : (Multiset.filter (fun x => x = q) x.toCharges.dedup) = {q} := by - simp [Multiset.filter_eq', h] - rw [hx] - simp + simp [reduce, Multiset.filter_map, Function.comp, Multiset.filter_eq', h] /-! @@ -224,9 +209,7 @@ lemma reduce_filter (x : FiveQuanta 𝓩) (q : 𝓩) (h : q ∈ x.toCharges) : @[simp] lemma reduce_reduce (x : FiveQuanta 𝓩) : x.reduce.reduce = x.reduce := by - refine Multiset.Nodup.toFinset_inj ?_ ?_ ?_ - · exact reduce_nodup x.reduce - · exact reduce_nodup x + refine Multiset.Nodup.toFinset_inj (reduce_nodup x.reduce) (reduce_nodup x) ?_ ext p simp only [Multiset.mem_toFinset] rw [mem_reduce_iff, reduce_toCharges, mem_reduce_iff] @@ -316,9 +299,8 @@ lemma reduce_eq_self_of_ofCharges_nodup (x : FiveQuanta 𝓩) (h : x.toCharges.N simp only [id_eq] have x_noDup : x.Nodup := Multiset.Nodup.of_map Prod.fst h suffices (Multiset.filter (fun f => f.1 = p.1) x) = {p} by simp [this] - refine (Multiset.Nodup.ext ?_ ?_).mpr ?_ - · exact Multiset.Nodup.filter (fun f => f.1 = p.1) x_noDup - · exact Multiset.nodup_singleton p + refine (Multiset.Nodup.ext (Multiset.Nodup.filter (fun f => f.1 = p.1) x_noDup) + (Multiset.nodup_singleton p)).mpr ?_ intro p' simp only [Multiset.mem_filter, Multiset.mem_singleton] constructor @@ -342,15 +324,12 @@ lemma reduce_toChargeMap_eq (x : FiveQuanta 𝓩) : x.reduce.toChargeMap = x.toChargeMap := by funext q by_cases h : q ∈ x.toCharges - · rw [toChargeMap, reduce_filter] - · simp - rfl - · exact h + · rw [toChargeMap, reduce_filter x q h] + simp + rfl · rw [toChargeMap_of_not_mem, toChargeMap_of_not_mem] · exact h - · rw [reduce_toCharges] - simp only [Multiset.mem_dedup] - exact h + · simpa [reduce_toCharges] using h /-! @@ -368,10 +347,7 @@ lemma mem_powerset_sum_of_mem_reduce_toFluxesFive {F : FiveQuanta 𝓩} obtain ⟨hq, rfl⟩ := hp simp only [Multiset.mem_map, Multiset.mem_powerset] use (Multiset.map (fun x => x.2) (Multiset.filter (fun x => x.1 = q) F)) - simp only [and_true] - rw [toFluxesFive] - refine Multiset.map_le_map ?_ - exact Multiset.filter_le (fun x => x.1 = q) F + exact ⟨Multiset.map_le_map (Multiset.filter_le _ F), rfl⟩ lemma mem_powerset_sum_of_mem_reduce_toFluxesFive_filter {F : FiveQuanta 𝓩} {f : Fluxes} (hf : f ∈ F.reduce.toFluxesFive) : @@ -386,10 +362,7 @@ lemma mem_powerset_sum_of_mem_reduce_toFluxesFive_filter {F : FiveQuanta 𝓩} simp only [and_true] rw [Multiset.mem_filter] apply And.intro - simp only [Multiset.mem_powerset] - rw [toFluxesFive] - refine Multiset.map_le_map ?_ - exact Multiset.filter_le (fun x => x.1 = q) F + exact Multiset.mem_powerset.mpr (Multiset.map_le_map (Multiset.filter_le (fun x => x.1 = q) F)) simp [Multiset.empty_eq_zero, ne_eq, Multiset.map_eq_zero, Multiset.filter_eq_nil, Prod.forall, not_forall, Decidable.not_not] rw [toCharges, Multiset.mem_map] at hq @@ -499,10 +472,9 @@ lemma reduce_numAntiChiralD_of_mem_elemsNoExotics {F : FiveQuanta 𝓩} lemma reduce_noExotics_of_mem_elemsNoExotics {F : FiveQuanta 𝓩} (hx : F.toFluxesFive ∈ FluxesFive.elemsNoExotics) : F.reduce.toFluxesFive.NoExotics := by - rw [FluxesFive.NoExotics] - rw [reduce_numChiralL_of_mem_elemsNoExotics hx, reduce_numAntiChiralL_of_mem_elemsNoExotics hx, - reduce_numChiralD_of_mem_elemsNoExotics hx, reduce_numAntiChiralD_of_mem_elemsNoExotics hx] - simp + simp [FluxesFive.NoExotics, reduce_numChiralL_of_mem_elemsNoExotics hx, + reduce_numAntiChiralL_of_mem_elemsNoExotics hx, reduce_numChiralD_of_mem_elemsNoExotics hx, + reduce_numAntiChiralD_of_mem_elemsNoExotics hx] /-! @@ -514,13 +486,11 @@ lemma reduce_mem_elemsNoExotics {F : FiveQuanta 𝓩} (hx : F.toFluxesFive ∈ FluxesFive.elemsNoExotics) : F.reduce.toFluxesFive ∈ FluxesFive.elemsNoExotics := by rw [← FluxesFive.noExotics_iff_mem_elemsNoExotics] - apply And.intro - · exact reduce_noExotics_of_mem_elemsNoExotics hx - · intro h - replace h := mem_powerset_sum_of_mem_reduce_toFluxesFive_filter h - generalize F.toFluxesFive = G at * - revert G - decide + refine ⟨reduce_noExotics_of_mem_elemsNoExotics hx, fun h => ?_⟩ + replace h := mem_powerset_sum_of_mem_reduce_toFluxesFive_filter h + generalize F.toFluxesFive = G at * + revert G + decide end reduce @@ -624,11 +594,8 @@ lemma decompose_toChargeMap [DecidableEq 𝓩] (x : FiveQuanta 𝓩) apply Multiset.map_congr · rfl intro a ha - apply decomposeFluxes_sum_of_noExotics - use x.toFluxesFive - simp_all [toFluxesFive] - use a.1 - exact ha.1 + exact decomposeFluxes_sum_of_noExotics a.2 + ⟨x.toFluxesFive, hx, Multiset.mem_map_of_mem Prod.snd (Multiset.mem_filter.mp ha).1⟩ /-! @@ -673,8 +640,7 @@ lemma decompose_reduce (x : FiveQuanta 𝓩) [DecidableEq 𝓩] · rw [decompose_toCharges_dedup x hx] · intro q hx' simp only [Prod.mk.injEq, true_and] - change x.decompose.toChargeMap q = x.toChargeMap q - rw [decompose_toChargeMap x hx] + exact congrFun (decompose_toChargeMap x hx) q /-! @@ -741,19 +707,8 @@ lemma toCharges_toFinset_of_mem_liftCharge (c : Finset 𝓩) {x : FiveQuanta rw [← Multiset.toFinset_dedup, reduce_toCharges] simp only [Int.reduceNeg, Multiset.dedup_idem, Multiset.toFinset_dedup] simp [toCharges] - trans (s1 + s2).toFinset - · exact Eq.symm (Multiset.toFinset_add s1 s2) - ext a - simp only [Multiset.toFinset_add, Finset.mem_union, Multiset.mem_toFinset] - constructor - · intro hr - rcases hr with hr | hr - · apply s1_subset - simpa using hr - · apply s2_subset - simpa using hr - · intro hr - simpa using Multiset.mem_of_le hsum hr + refine Finset.Subset.antisymm (Finset.union_subset s1_subset s2_subset) fun a ha => ?_ + simpa using Multiset.mem_of_le hsum ha /-! @@ -765,8 +720,7 @@ lemma toCharges_nodup_of_mem_liftCharge (c : Finset 𝓩) {x : FiveQuanta 𝓩} (h : x ∈ liftCharge c) : x.toCharges.Nodup := by rw [liftCharge, Multiset.mem_map] at h obtain ⟨x, h, rfl⟩ := h - rw [reduce_toCharges] - exact Multiset.nodup_dedup x.toCharges + simp [reduce_toCharges] /-! @@ -784,10 +738,7 @@ lemma exists_toCharges_toFluxesFive_of_mem_liftCharge (c : Finset 𝓩) {x : Fiv use a simp only [Int.reduceNeg, Multiset.insert_eq_cons, true_and] apply And.intro - · trans a.toCharges.dedup.toFinset - · simp - rw [← reduce_toCharges] - exact toCharges_toFinset_of_mem_liftCharge c h' + · simpa [reduce_toCharges] using toCharges_toFinset_of_mem_liftCharge c h' · simp at h obtain ⟨s1, s2, ⟨⟨⟨s1_subset, s1_card⟩, ⟨s2_subset, s2_card⟩⟩, hsum⟩, rfl⟩ := h simp [toFluxesFive, s1_card, s2_card] @@ -813,11 +764,8 @@ lemma mem_liftCharge_of_exists_toCharges_toFluxesFive (c : Finset 𝓩) {x : Fiv have hmap : ∀ v : Fluxes, Multiset.map (fun y => (y.1, v)) (x.filter (fun y => y.2 = v)) = x.filter (fun y => y.2 = v) := by intro v - trans Multiset.map (fun y => y) (x.filter (fun y => y.2 = v)) - · refine Multiset.map_congr rfl fun y hy => ?_ - simp only [Multiset.mem_filter] at hy - rw [← hy.2] - · simp + refine (Multiset.map_congr rfl fun y hy => ?_).trans (Multiset.map_id _) + simp [← (Multiset.mem_filter.mp hy).2] have hx : Multiset.filter (fun y => y.2 = ⟨0, 1⟩) x = Multiset.filter (fun y => ¬ y.2 = ⟨1, -1⟩) x := by refine Multiset.filter_congr ?_ @@ -825,9 +773,7 @@ lemma mem_liftCharge_of_exists_toCharges_toFluxesFive (c : Finset 𝓩) {x : Fiv have h1 : p.2 ∈ x.toFluxesFive := by simp [toFluxesFive]; use p.1 rw [h2] at h1 simp_all - rcases h1 with hp | hp - · simp [hp] - · simp [hp] + rcases h1 with hp | hp <;> simp [hp] refine ⟨⟨⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩, ?_⟩, ?_⟩ · simp [s1, ← h, toCharges] · simp [s1] @@ -897,10 +843,8 @@ lemma mem_liftCharge_of_mem_noExotics_hasNoZero (c : Finset 𝓩) {x : FiveQuant (h1 : x.toFluxesFive.NoExotics) (h2 : x.toFluxesFive.HasNoZero) (h3 : x.toCharges.toFinset = c) (h4 : x.toCharges.Nodup) : x ∈ liftCharge c := by - have hf : x.toFluxesFive ∈ FluxesFive.elemsNoExotics := by - rw [← FluxesFive.noExotics_iff_mem_elemsNoExotics] - simp_all - exact h2 + have hf : x.toFluxesFive ∈ FluxesFive.elemsNoExotics := + (FluxesFive.noExotics_iff_mem_elemsNoExotics _).mp ⟨h1, h2⟩ rw [mem_liftCharge_iff_exists] use x.decompose apply And.intro @@ -920,9 +864,7 @@ lemma mem_liftCharge_iff (c : Finset 𝓩) (x : FiveQuanta 𝓩) : · intro h refine ⟨?_, ?_, ?_⟩ · rw [← FluxesFive.noExotics_iff_mem_elemsNoExotics] - refine ⟨?_, ?_⟩ - · exact noExotics_of_mem_liftCharge c x h - · exact hasNoZero_of_mem_liftCharge c h + exact ⟨noExotics_of_mem_liftCharge c x h, hasNoZero_of_mem_liftCharge c h⟩ · exact toCharges_toFinset_of_mem_liftCharge c h · exact toCharges_nodup_of_mem_liftCharge c h · intro ⟨h1, h2, h3⟩ @@ -944,8 +886,7 @@ lemma map_liftCharge {𝓩 𝓩1 : Type}[DecidableEq 𝓩] [DecidableEq 𝓩1] [ simpa [toFluxesFive, Multiset.map_map] using h.1 · rw [reduce_toCharges] simp [← h.2.1, ← Multiset.toFinset_map, toCharges] - · rw [reduce_toCharges] - exact Multiset.nodup_dedup (toCharges (Multiset.map (fun y => (f y.1, y.2)) F)) + · simp [reduce_toCharges] end ofChargesExpand diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean index 2b2cb656a..971bbfee4 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean @@ -123,11 +123,8 @@ lemma isViable_iff_def (x : Quanta) : IsViable x ↔ x.T.toFluxesTen.NoExotics ∧ x.T.toFluxesTen.HasNoZero ∧ x.LinearAnomalyCancellation := by - apply Iff.intro - · rintro ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ - · rintro ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ + refine ⟨fun ⟨a, b, c, d, e, f, g, h, i, j, k, l⟩ => ⟨a, b, c, d, e, f, g, h, i, j, k, l⟩, ?_⟩ + exact fun ⟨a, b, c, d, e, f, g, h, i, j, k, l⟩ => ⟨a, b, c, d, e, f, g, h, i, j, k, l⟩ /-! @@ -148,10 +145,7 @@ lemma isViable_iff_charges_mem_viableCharges (x : Quanta) : x.T.toFluxesTen.HasNoZero ∧ /- 3. Conditions on the fluxes and the charges. -/ x.LinearAnomalyCancellation := by - rw [isViable_iff_def] - conv_rhs => - enter [1, 1, I] - rw [mem_viableCharges_iff'] + simp only [isViable_iff_def, mem_viableCharges_iff'] aesop /-! @@ -164,10 +158,9 @@ lemma isViable_iff_charges_mem_viableCharges_mem_liftCharges (x : Quanta) : IsViable x ↔ (∃ I, x.toCharges ∈ viableCharges I) ∧ x ∈ Quanta.liftCharge x.toCharges ∧ x.LinearAnomalyCancellation := by - rw [Quanta.mem_liftCharge_iff] - simp [toCharges_qHd, toCharges_qHu] - rw [FiveQuanta.mem_liftCharge_iff, TenQuanta.mem_liftCharge_iff] - rw [isViable_iff_charges_mem_viableCharges, ← FluxesFive.noExotics_iff_mem_elemsNoExotics, + simp [Quanta.mem_liftCharge_iff, toCharges_qHd, toCharges_qHu] + rw [FiveQuanta.mem_liftCharge_iff, TenQuanta.mem_liftCharge_iff, + isViable_iff_charges_mem_viableCharges, ← FluxesFive.noExotics_iff_mem_elemsNoExotics, ← FluxesTen.noExotics_iff_mem_elemsNoExotics] aesop @@ -181,8 +174,7 @@ lemma isViable_iff_filter (x : Quanta) : IsViable x ↔ (∃ I, x.toCharges ∈ (viableCharges I).filter IsAnomalyFree) ∧ x ∈ Quanta.liftCharge x.toCharges ∧ x.LinearAnomalyCancellation := by - rw [isViable_iff_charges_mem_viableCharges_mem_liftCharges] - simp [IsAnomalyFree] + simp [isViable_iff_charges_mem_viableCharges_mem_liftCharges, IsAnomalyFree] aesop /-! diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean index c0b4841c6..f2adeb9c8 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean @@ -135,10 +135,8 @@ def toChargeMap [DecidableEq 𝓩] (x : TenQuanta 𝓩) : 𝓩 → Fluxes := lemma toChargeMap_of_not_mem [DecidableEq 𝓩] (x : TenQuanta 𝓩) {z : 𝓩} (h : z ∉ x.toCharges) : x.toChargeMap z = 0 := by - have hl : x.filter (fun p => p.1 = z) = 0 := by - rw [Multiset.filter_eq_nil] - rintro ⟨a, b⟩ hp rfl - exact h (Multiset.mem_map_of_mem Prod.fst hp) + have hl : x.filter (fun p => p.1 = z) = 0 := + Multiset.filter_eq_nil.2 fun p hp hpz => h (hpz ▸ Multiset.mem_map_of_mem Prod.fst hp) simp [toChargeMap, hl] /-! @@ -164,9 +162,7 @@ def reduce (x : TenQuanta 𝓩) : TenQuanta 𝓩 := lemma reduce_nodup (x : TenQuanta 𝓩) : x.reduce.Nodup := by rw [reduce] - refine Multiset.Nodup.map ?_ (Multiset.nodup_dedup _) - intro a b h - exact congrArg Prod.fst h + exact Multiset.Nodup.map (fun _ _ h => congrArg Prod.fst h) (Multiset.nodup_dedup _) @[simp] lemma reduce_dedup (x : TenQuanta 𝓩) : x.reduce.dedup = x.reduce := @@ -192,14 +188,10 @@ lemma mem_reduce_iff (x : TenQuanta 𝓩) (p : 𝓩 × Fluxes) : p.2 = ((x.filter (fun f => f.1 = p.1)).map (fun y => y.2)).sum := by simp [reduce] constructor - · intro h - obtain ⟨q, h1, rfl⟩ := h - simp_all - · simp only [and_imp] - intro h1 h2 - use p.1 - simp_all - rw [← h2] + · rintro ⟨q, hq, rfl⟩ + exact ⟨hq, rfl⟩ + · rintro ⟨h1, h2⟩ + exact ⟨p.1, h1, by rw [← h2]⟩ /-! @@ -214,16 +206,7 @@ lemma reduce_filter (x : TenQuanta 𝓩) (q : 𝓩) (h : q ∈ x.toCharges) : rw [Multiset.filter_map] simp only [Function.comp_apply] have hx : (Multiset.filter (fun x => x = q) x.toCharges.dedup) = {q} := by - refine (Multiset.Nodup.ext ?_ ?_).mpr ?_ - · refine Multiset.Nodup.filter (fun x => x = q) ?_ - exact Multiset.nodup_dedup x.toCharges - · exact Multiset.nodup_singleton q - intro a - simp only [Multiset.mem_filter, Multiset.mem_dedup, Multiset.mem_singleton, - and_iff_right_iff_imp] - intro h' - subst h' - exact h + rw [Multiset.filter_eq', Multiset.count_dedup, if_pos h, Multiset.replicate_one] rw [hx] simp @@ -236,19 +219,13 @@ lemma reduce_filter (x : TenQuanta 𝓩) (q : 𝓩) (h : q ∈ x.toCharges) : @[simp] lemma reduce_reduce (x : TenQuanta 𝓩) : x.reduce.reduce = x.reduce := by - refine Multiset.Nodup.toFinset_inj ?_ ?_ ?_ - · exact reduce_nodup x.reduce - · exact reduce_nodup x + refine Multiset.Nodup.toFinset_inj (reduce_nodup x.reduce) (reduce_nodup x) ?_ ext p simp only [Multiset.mem_toFinset] rw [mem_reduce_iff, reduce_toCharges, mem_reduce_iff] simp only [Multiset.mem_dedup, and_congr_right_iff] intro hp - have h1 (a b c : Fluxes) (h : b = c) : a = b ↔ a = c := by subst h; rfl - apply h1 - rw [reduce_filter] - simp only [Multiset.map_singleton, Multiset.sum_singleton] - exact hp + rw [reduce_filter x p.1 hp, Multiset.map_singleton, Multiset.sum_singleton] /-! @@ -323,8 +300,7 @@ lemma reduce_sum_eq_sum_toCharges {M} [AddCommMonoid M] (x : TenQuanta 𝓩) (f lemma reduce_eq_self_of_ofCharges_nodup (x : TenQuanta 𝓩) (h : x.toCharges.Nodup) : x.reduce = x := by - rw [reduce] - rw [Multiset.Nodup.dedup h] + rw [reduce, Multiset.Nodup.dedup h] simp [toCharges] conv_rhs => rw [← Multiset.map_id x] apply Multiset.map_congr rfl @@ -340,11 +316,8 @@ lemma reduce_eq_self_of_ofCharges_nodup (x : TenQuanta 𝓩) (h : x.toCharges.No constructor · rintro ⟨h1, h2⟩ simp [toCharges] at h - rw [propext (Multiset.nodup_map_iff_inj_on x_noDup)] at h - apply h - · exact h1 - · exact hp - · exact h2 + rw [Multiset.nodup_map_iff_inj_on x_noDup] at h + exact h p' h1 p hp h2 · rintro ⟨rfl⟩ simp_all @@ -359,8 +332,7 @@ lemma reduce_toChargeMap_eq (x : TenQuanta 𝓩) : funext q by_cases h : q ∈ x.toCharges · rw [toChargeMap, reduce_filter] - · simp - rfl + · simp [toChargeMap] · exact h · rw [toChargeMap_of_not_mem, toChargeMap_of_not_mem] · exact h @@ -566,10 +538,10 @@ lemma reduce_numAntiChiralE_of_mem_elemsNoExotics {F : TenQuanta 𝓩} lemma reduce_noExotics_of_mem_elemsNoExotics {F : TenQuanta 𝓩} (hx : F.toFluxesTen ∈ FluxesTen.elemsNoExotics) : F.reduce.toFluxesTen.NoExotics := by - rw [FluxesTen.NoExotics] - rw [reduce_numChiralU_of_mem_elemsNoExotics hx, reduce_numAntiChiralU_of_mem_elemsNoExotics hx, - reduce_numChiralQ_of_mem_elemsNoExotics hx, reduce_numAntiChiralQ_of_mem_elemsNoExotics hx, - reduce_numChiralE_of_mem_elemsNoExotics hx, reduce_numAntiChiralE_of_mem_elemsNoExotics hx] + rw [FluxesTen.NoExotics, reduce_numChiralU_of_mem_elemsNoExotics hx, + reduce_numAntiChiralU_of_mem_elemsNoExotics hx, reduce_numChiralQ_of_mem_elemsNoExotics hx, + reduce_numAntiChiralQ_of_mem_elemsNoExotics hx, reduce_numChiralE_of_mem_elemsNoExotics hx, + reduce_numAntiChiralE_of_mem_elemsNoExotics hx] simp /-! @@ -582,13 +554,12 @@ lemma reduce_mem_elemsNoExotics {F : TenQuanta 𝓩} (hx : F.toFluxesTen ∈ FluxesTen.elemsNoExotics) : F.reduce.toFluxesTen ∈ FluxesTen.elemsNoExotics := by rw [← FluxesTen.noExotics_iff_mem_elemsNoExotics] - apply And.intro - · exact reduce_noExotics_of_mem_elemsNoExotics hx - · intro h - replace h := mem_powerset_sum_of_mem_reduce_toFluxesTen_filter h - generalize F.toFluxesTen = G at * - revert G - decide + refine ⟨reduce_noExotics_of_mem_elemsNoExotics hx, ?_⟩ + intro h + replace h := mem_powerset_sum_of_mem_reduce_toFluxesTen_filter h + generalize F.toFluxesTen = G at * + revert G + decide end reduce @@ -662,8 +633,7 @@ lemma decompose_filter_charge [DecidableEq 𝓩] (x : TenQuanta 𝓩) (q : 𝓩) simp only [Multiset.cons_bind, Multiset.filter_add] rw [Multiset.filter_cons, decompose_add, ih] congr - match a with - | (q', f) => + obtain ⟨q', f⟩ := a simp [decomposeFluxes] by_cases h : q' = q · subst h @@ -686,9 +656,7 @@ lemma decompose_toChargeMap [DecidableEq 𝓩] (x : TenQuanta 𝓩) simp only [Multiset.map_map, Function.comp_apply, Multiset.map_id', Multiset.sum_bind] rw [toChargeMap] congr 1 - apply Multiset.map_congr - · rfl - intro a ha + refine Multiset.map_congr rfl fun a ha => ?_ apply decomposeFluxes_sum_of_noExotics use x.toFluxesTen simp_all [toFluxesTen] @@ -734,12 +702,10 @@ lemma decompose_reduce (x : TenQuanta 𝓩) [DecidableEq 𝓩] (hx : x.toFluxesTen ∈ FluxesTen.elemsNoExotics) : x.decompose.reduce = x.reduce := by rw [reduce, reduce] - apply Multiset.map_congr - · rw [decompose_toCharges_dedup x hx] - · intro q hx' - simp only [Prod.mk.injEq, true_and] - change x.decompose.toChargeMap q = x.toChargeMap q - rw [decompose_toChargeMap x hx] + refine Multiset.map_congr (decompose_toCharges_dedup x hx) fun q hx' => ?_ + simp only [Prod.mk.injEq, true_and] + change x.decompose.toChargeMap q = x.toChargeMap q + rw [decompose_toChargeMap x hx] /-! @@ -825,7 +791,7 @@ lemma toCharge_toFinset_of_mem_liftCharge (c : Finset 𝓩) exact Multiset.mem_of_le h' hr · obtain ⟨⟨q1, q2, q3, h, rfl⟩, h'⟩ := h simp_all [toCharges] - refine Eq.symm ((fun {α} {s₁ s₂} => Finset.ext_iff.mpr) ?_) + refine Eq.symm (Finset.ext_iff.mpr ?_) intro a constructor · intro hr @@ -907,9 +873,7 @@ lemma mem_liftCharge_of_exists_toCharges_toFluxesTen (c : Finset 𝓩) {x : TenQ swap · simp rw [toCharges, Multiset.map_map] - apply Multiset.map_congr - rfl - intro p hp + refine Multiset.map_congr rfl fun p hp => ?_ simp only [Function.comp_apply] have h1 : p.2 ∈ x.toFluxesTen := by simp [toFluxesTen] @@ -944,8 +908,7 @@ lemma mem_liftCharge_of_exists_toCharges_toFluxesTen (c : Finset 𝓩) {x : TenQ apply Multiset.erase_subset p2 _ rw [hp3] simp - · symm - refine Eq.symm (Multiset.eq_of_le_of_card_le ?_ ?_) + · refine Multiset.eq_of_le_of_card_le ?_ ?_ · refine (Multiset.cons_le_of_notMem ?_).mpr ⟨?_, ?_⟩ · simp · rw [← hp1_2] @@ -1025,19 +988,16 @@ lemma mem_liftCharge_of_mem_noExotics_hasNoZero (c : Finset 𝓩) {x : TenQuanta x ∈ liftCharge c := by have hf : x.toFluxesTen ∈ FluxesTen.elemsNoExotics := by rw [← FluxesTen.noExotics_iff_mem_elemsNoExotics] - simp_all - exact h2 + exact ⟨h1, h2⟩ rw [mem_liftCharge_iff_exists] - use x.decompose - apply And.intro + refine ⟨x.decompose, ?_, ?_, ?_⟩ · rw [decompose_reduce x hf] exact reduce_eq_self_of_ofCharges_nodup x h4 - · constructor - · trans x.decompose.toCharges.dedup.toFinset - · simp - · rw [decompose_toCharges_dedup x hf, ← h3] - simp - · exact decompose_toFluxesTen x hf + · trans x.decompose.toCharges.dedup.toFinset + · simp + · rw [decompose_toCharges_dedup x hf, ← h3] + simp + · exact decompose_toFluxesTen x hf lemma mem_liftCharge_iff (c : Finset 𝓩) (x : TenQuanta 𝓩) : x ∈ liftCharge c ↔ x.toFluxesTen ∈ FluxesTen.elemsNoExotics @@ -1046,9 +1006,7 @@ lemma mem_liftCharge_iff (c : Finset 𝓩) (x : TenQuanta 𝓩) : · intro h refine ⟨?_, ?_, ?_⟩ · rw [← FluxesTen.noExotics_iff_mem_elemsNoExotics] - refine ⟨?_, ?_⟩ - · exact noExotics_of_mem_liftCharge c x h - · exact hasNoZero_of_mem_liftCharge c h + exact ⟨noExotics_of_mem_liftCharge c x h, hasNoZero_of_mem_liftCharge c h⟩ · exact toCharge_toFinset_of_mem_liftCharge c h · exact toCharges_nodup_of_mem_liftCharge c h · intro ⟨h1, h2, h3⟩ diff --git a/Physlib/Units/UnitDependent.lean b/Physlib/Units/UnitDependent.lean index 735268ecf..8784f3a45 100644 --- a/Physlib/Units/UnitDependent.lean +++ b/Physlib/Units/UnitDependent.lean @@ -90,15 +90,8 @@ lemma UnitDependent.scaleUnit_symm_apply {M : Type} [UnitDependent M] @[simp] lemma UnitDependent.scaleUnit_injective {M : Type} [UnitDependent M] (u1 u2 : UnitChoices) (m1 m2 : M) : - scaleUnit u1 u2 m1 = scaleUnit u1 u2 m2 ↔ m1 = m2 := by - constructor - · intro h1 - have h2 : scaleUnit u2 u1 (scaleUnit u1 u2 m1) = - scaleUnit u2 u1 (scaleUnit u1 u2 m2) := by rw [h1] - simpa using h2 - · intro h - subst h - rfl + scaleUnit u1 u2 m1 = scaleUnit u1 u2 m2 ↔ m1 = m2 := + ⟨fun h => by simpa using congrArg (scaleUnit u2 u1) h, congrArg (scaleUnit u1 u2)⟩ /-! @@ -199,45 +192,22 @@ noncomputable instance : UnitDependent UnitChoices where @[simp] lemma UnitChoices.scaleUnit_apply_fst (u1 u2 : UnitChoices) : (scaleUnit u1 u2 u1) = u2 := by - simp [scaleUnit] - apply UnitChoices.ext - · simp [LengthUnit.scale, LengthUnit.div_eq_val, toReal] - · simp [TimeUnit.scale, TimeUnit.div_eq_val, toReal] - · simp [MassUnit.scale, MassUnit.div_eq_val, toReal] - · simp [ChargeUnit.scale, ChargeUnit.div_eq_val, toReal] - · simp [TemperatureUnit.scale, TemperatureUnit.div_eq_val, toReal] + ext <;> simp [scaleUnit, LengthUnit.scale, TimeUnit.scale, MassUnit.scale, ChargeUnit.scale, + TemperatureUnit.scale, LengthUnit.div_eq_val, TimeUnit.div_eq_val, MassUnit.div_eq_val, + ChargeUnit.div_eq_val, TemperatureUnit.div_eq_val, toReal] @[simp] lemma UnitChoices.dimScale_scaleUnit {u1 u2 u : UnitChoices} (d : Dimension) : u.dimScale (scaleUnit u1 u2 u) d = u1.dimScale u2 d := by - simp [dimScale] - congr 1 - congr 1 - congr 1 - congr 1 - · congr 1 - simp [scaleUnit] - simp [LengthUnit.div_eq_val, toReal] - · congr 1 - simp [scaleUnit] - simp [TimeUnit.div_eq_val, toReal] - · congr 1 - simp [scaleUnit] - simp [MassUnit.div_eq_val, toReal] - · congr 1 - simp [scaleUnit] - simp [ChargeUnit.div_eq_val, toReal] - · congr 1 - simp [scaleUnit] - simp [TemperatureUnit.div_eq_val, toReal] + simp [dimScale, scaleUnit] + simp [LengthUnit.div_eq_val, TimeUnit.div_eq_val, MassUnit.div_eq_val, ChargeUnit.div_eq_val, + TemperatureUnit.div_eq_val, toReal] lemma Dimensionful.of_scaleUnit {M : Type} [CarriesDimension M] {u1 u2 u : UnitChoices} (c : Dimensionful M) : c.1 (scaleUnit u1 u2 u) = u1.dimScale u2 (dim M) • c.1 (u) := by - rw [c.2 u (scaleUnit u1 u2 u)] - congr 1 - simp + rw [c.2 u (scaleUnit u1 u2 u), UnitChoices.dimScale_scaleUnit] noncomputable instance {M1 : Type} [CarriesDimension M1] : MulUnitDependent M1 where scaleUnit u1 u2 m := (toDimensionful u1 m).1 u2 @@ -254,33 +224,18 @@ noncomputable instance {M1 : Type} [CarriesDimension M1] : MulUnitDependent M1 w lemma HasDim.scaleUnit_apply {M : Type} [CarriesDimension M] (u1 u2 : UnitChoices) (m : M) : - scaleUnit u1 u2 m = (u1.dimScale u2 (dim M)) • m := by - simp [scaleUnit, toDimensionful_apply_apply] + scaleUnit u1 u2 m = (u1.dimScale u2 (dim M)) • m := + toDimensionful_apply_apply u1 u2 m noncomputable instance {M : Type} [AddCommMonoid M] [Module ℝ M] [HasDim M] : LinearUnitDependent M where - scaleUnit_add u1 u2 m1 m2 := by - change (toDimensionful u1 (m1 + m2)).1 u2 = _ - rw [toDimensionful_apply_apply] - simp - rfl - scaleUnit_smul u1 u2 r m := by - change (toDimensionful u1 (r • m)).1 u2 = _ - rw [toDimensionful_apply_apply] - rw [smul_comm] - rfl + scaleUnit_add u1 u2 m1 m2 := smul_add (u1.dimScale u2 (dim M)) m1 m2 + scaleUnit_smul u1 u2 r m := smul_comm (u1.dimScale u2 (dim M)) r m noncomputable instance {M : Type} [AddCommMonoid M] [Module ℝ M] [HasDim M] [TopologicalSpace M] [ContinuousConstSMul ℝ M] : ContinuousLinearUnitDependent M where - scaleUnit_cont u1 u2 := by - change Continuous fun m => (toDimensionful u1 m).1 u2 - conv => - enter [1, m] - rw [toDimensionful_apply_apply] - change Continuous fun m => (u1.dimScale u2 (dim M)).1 • m - apply Continuous.const_smul - exact continuous_id' + scaleUnit_cont u1 u2 := continuous_const_smul (u1.dimScale u2 (dim M)).1 /-! @@ -472,24 +427,21 @@ lemma isDimensionallyCorrect_fun_iff {M1 M2 : Type} [UnitDependent M1] [UnitDepe {f : M1 → M2} : IsDimensionallyCorrect f ↔ ∀ u1 u2 : UnitChoices, ∀ m, scaleUnit u1 u2 (f (scaleUnit u2 u1 m)) = f m := by - simp only [IsDimensionallyCorrect, funext_iff] - rfl + simp [IsDimensionallyCorrect, funext_iff] @[simp] lemma isDimensionallyCorrect_fun_left {M1 M2 : Type} [UnitDependent M1] {f : M1 → M2} : IsDimensionallyCorrect f ↔ ∀ u1 u2 : UnitChoices, ∀ m, (f (scaleUnit u2 u1 m)) = f m := by - simp only [IsDimensionallyCorrect, funext_iff] - rfl + simp [IsDimensionallyCorrect, funext_iff] @[simp] lemma isDimensionallyCorrect_fun_right {M1 M2 : Type} [UnitDependent M2] {f : M1 → M2} : IsDimensionallyCorrect f ↔ ∀ u1 u2 : UnitChoices, ∀ m, scaleUnit u1 u2 (f m) = f m := by - simp only [IsDimensionallyCorrect, funext_iff] - rfl + simp [IsDimensionallyCorrect, funext_iff] /-! ## Some type classes to help track dimensions @@ -509,12 +461,8 @@ lemma DMul.hMul_scaleUnit {M1 M2 M3 : Type} [CarriesDimension M1] [CarriesDimens [DMul M1 M2 M3] (m1 : M1) (m2 : M2) (u1 u2 : UnitChoices) : (scaleUnit u1 u2 m1) * (scaleUnit u1 u2 m2) = scaleUnit u1 u2 (m1 * m2) := by - simp [scaleUnit, toDimensionful] - have h1 := DMul.mul_dim (M3 := M3) (toDimensionful u1 m1) (toDimensionful u1 m2) u2 u1 - simp [toDimensionful_apply_apply] at h1 - conv_rhs => - rw [h1, smul_smul] - simp + simpa [scaleUnit, toDimensionful] using + DMul.mul_dim (M3 := M3) (toDimensionful u1 m1) (toDimensionful u1 m2) u1 u2 /-! @@ -548,9 +496,7 @@ instance (M : Type) [MulAction ℝ≥0 M] [MulUnitDependent M] (d : Dimension) : @[simp] lemma scaleUnit_dimSet_val {M : Type} [MulAction ℝ≥0 M] [MulUnitDependent M] (d : Dimension) (m : DimSet M d) (u1 u2 : UnitChoices) : - (scaleUnit u1 u2 m).1 = scaleUnit u1 u2 m.1 := by - rw [HasDim.scaleUnit_apply, m.2] - rfl + (scaleUnit u1 u2 m).1 = scaleUnit u1 u2 m.1 := (m.2 u1 u2).symm lemma DimSet.mem_iff {M : Type} [MulAction ℝ≥0 M] [MulUnitDependent M] (d : Dimension) (m : M) : m ∈ DimSet M d ↔ ∀ u1 u2, scaleUnit u1 u2 m = (UnitChoices.dimScale u1 u2 d) • m := by rfl diff --git a/Physlib/Units/WithDim/Area.lean b/Physlib/Units/WithDim/Area.lean index ca58d950c..f78b980b9 100644 --- a/Physlib/Units/WithDim/Area.lean +++ b/Physlib/Units/WithDim/Area.lean @@ -68,19 +68,17 @@ lemma squareMeter_in_SI : squareMeter.1 SI = ⟨1⟩ := by @[simp] lemma squareFoot_in_SI : squareFoot.1 SI = ⟨0.09290304⟩ := by - simp [squareFoot, dimScale, LengthUnit.feet, toDimensionful_apply_apply,] + simp [squareFoot, dimScale, LengthUnit.feet, toDimensionful_apply_apply] ext simp [NNReal.coe_ofScientific] - rw [toReal] - norm_num + norm_num [toReal] @[simp] lemma squareMile_in_SI : squareMile.1 SI = ⟨2589988.110336⟩ := by simp [squareMile, dimScale, LengthUnit.miles, toDimensionful_apply_apply] ext simp [NNReal.coe_ofScientific] - rw [toReal] - norm_num + norm_num [toReal] @[simp] lemma are_in_SI : are.1 SI = ⟨100⟩ := by @@ -95,8 +93,7 @@ lemma acre_in_SI : acre.1 SI = ⟨4046.8564224⟩ := by simp [acre, dimScale, LengthUnit.miles, toDimensionful_apply_apply] ext simp [NNReal.coe_ofScientific] - rw [toReal] - norm_num + norm_num [toReal] /-! @@ -107,8 +104,7 @@ lemma acre_in_SI : acre.1 SI = ⟨4046.8564224⟩ := by /-- One acre is exactly `43560` square feet. -/ lemma acre_eq_mul_squareFeet : acre = (43560 : ℝ≥0) • squareFoot := by apply (toDimensionful SI).symm.injective - simp [toDimensionful] ext - norm_num + norm_num [toDimensionful] end DimArea diff --git a/Physlib/Units/WithDim/Speed.lean b/Physlib/Units/WithDim/Speed.lean index aa76ce536..488ebb741 100644 --- a/Physlib/Units/WithDim/Speed.lean +++ b/Physlib/Units/WithDim/Speed.lean @@ -68,8 +68,7 @@ lemma oneMilePerHour_in_SI : oneMilePerHour SI = ⟨0.44704⟩ := by simp [oneMilePerHour, dimScale, LengthUnit.miles, TimeUnit.hours, toDimensionful_apply_apply] ext simp [NNReal.coe_ofScientific] - rw [toReal] - norm_num + norm_num [toReal] @[simp] lemma oneKilometerPerHour_in_SI : @@ -79,8 +78,7 @@ lemma oneKilometerPerHour_in_SI : ext simp only [WithDim.smul_val, smul_eq_mul, mul_one, NNReal.coe_mul, coe_rpow, NNReal.coe_div, NNReal.coe_ofNat] - rw [toReal] - norm_num + norm_num [toReal] @[simp] lemma oneKnot_in_SI : oneKnot SI = ⟨463/900⟩ := by @@ -88,8 +86,7 @@ lemma oneKnot_in_SI : oneKnot SI = ⟨463/900⟩ := by ext simp only [WithDim.smul_val, smul_eq_mul, mul_one, NNReal.coe_mul, coe_rpow, NNReal.coe_div, NNReal.coe_ofNat] - rw [toReal] - norm_num + norm_num [toReal] @[simp] lemma speedOfLight_in_SI : speedOfLight SI = ⟨299792458⟩ := by @@ -104,22 +101,19 @@ lemma speedOfLight_in_SI : speedOfLight SI = ⟨299792458⟩ := by lemma oneKnot_eq_mul_oneKilometerPerHour : oneKnot = (1.852 : ℝ≥0) • oneKilometerPerHour := by apply (toDimensionful SI).symm.injective - simp [toDimensionful] ext - norm_num + norm_num [toDimensionful] lemma oneKilometerPerHour_eq_mul_oneKnot: oneKilometerPerHour = (250/463 : ℝ≥0) • oneKnot := by apply (toDimensionful SI).symm.injective - simp [toDimensionful] ext - norm_num + norm_num [toDimensionful] lemma oneMeterPerSecond_eq_mul_oneMilePerHour : oneMeterPerSecond = (3125/1397 : ℝ≥0) • oneMilePerHour := by apply (toDimensionful SI).symm.injective - simp [toDimensionful] ext - norm_num + norm_num [toDimensionful] end DimSpeed diff --git a/scripts/check_golf.py b/scripts/check_golf.py index 69dfcafd8..23fed11f8 100755 --- a/scripts/check_golf.py +++ b/scripts/check_golf.py @@ -743,7 +743,7 @@ def measure_files(base: str, head: str, reports: List[FileReport], itself verifies -- because only proof/body text then differs. """ paths = [r.path for r in reports - if r.proof_golfed or r.embedded_proof_changed or r.def_body_changed] + if r.proof_golfed or r.embedded_proof_changed or r.def_value_changed] if limit is not None: paths = paths[:limit] out: List[Measurement] = []