Selecting only the quartic terms from an expression

Question

I am trying to create a function that returns a list with every quartic term (in total, meaning that \[CapitalPhi]1^2 * \[CapitalPhi]2 ^2 would count).

what I have is :

    QuarticTerms[potential_, fields_] := 
  Module[{quarticTerms}, 
   quarticTerms = 
    Select[List @@ Expand[potential], 
     Total[Exponent[#, fields]] == 4 &];
   Return[quarticTerms];];

and the expression I am using is:

potential = 
  m11^2  Abs[\[CapitalPhi]1]^2 + m22^2  Abs[\[CapitalPhi]2]^2 - 
   m12^2  (Conjugate[\[CapitalPhi]1]  \[CapitalPhi]2 + 
      Conjugate[\[CapitalPhi]2]  \[CapitalPhi]1) + 
   1/2  \[Lambda]1  Abs[\[CapitalPhi]1]^4 + 
   1/2  \[Lambda]2  Abs[\[CapitalPhi]2]^4 + \[Lambda]3  Abs[\
\[CapitalPhi]1]^2  Abs[\[CapitalPhi]2]^2 + \[Lambda]4  Abs[\
\[CapitalPhi]1*\[CapitalPhi]2]^2 + 
   1/2  \[Lambda]5  ((Conjugate[\[CapitalPhi]1]  \[CapitalPhi]2)^2 + \
(Conjugate[\[CapitalPhi]2]  \[CapitalPhi]1)^2) + 
   1/2  mS^2  Abs[\[CapitalPhi]S]^2 + 
   1/8  \[Lambda]6  Abs[\[CapitalPhi]S]^4 + 
   1/2  \[Lambda]7  Abs[\[CapitalPhi]1]^2  Abs[\[CapitalPhi]S]^2 + 
   1/2  \[Lambda]8  Abs[\[CapitalPhi]2]^2  Abs[\[CapitalPhi]S]^2;

It always returns an empty list. Is the function poorly defined or is it due to the complexity of the expression?

Answer 1

$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

QuarticTerms[potential_, fields_] := 
 Select[List @@ Expand[potential], 
  Total[Exponent[#, fields]] == 4 &]

potential = 
  m11^2   Abs[Φ1]^2 + m22^2   Abs[Φ2]^2 - 
   m12^2   (Conjugate[Φ1]   Φ2 + 
      Conjugate[Φ2]   Φ1) + 
   1/2   λ1   Abs[Φ1]^4 + 
   1/2   λ2   Abs[Φ2]^4 + λ3   Abs[\
Φ1]^2   Abs[Φ2]^2 + λ4   Abs[\
Φ1*Φ2]^2 + 
   1/2   λ5   ((Conjugate[Φ1]   Φ2)^2 \
+ (Conjugate[Φ2]   Φ1)^2) + 
   1/2   mS^2   Abs[ΦS]^2 + 
   1/8   λ6   Abs[ΦS]^4 + 
   1/2   λ7   Abs[Φ1]^2   Abs[ΦS]^2 + 
   1/2   λ8   Abs[Φ2]^2   Abs[ΦS]^2;

fields = 
 Outer[#2[#1] &, {Φ1, Φ2, ΦS}, \
{Identity, Abs, Conjugate}] // Flatten

(* {Φ1, Abs[Φ1], Conjugate[Φ1], Φ2, Abs[Φ2], 
 Conjugate[Φ2], ΦS, Abs[ΦS], Conjugate[ΦS]} *)

QuarticTerms[potential, fields]

(* {1/2 λ1 Abs[Φ1]^4, λ3 \
Abs[Φ1]^2 Abs[Φ2]^2, 
 1/2 λ2 Abs[Φ2]^4, 
 1/2 λ7 Abs[Φ1]^2 Abs[ΦS]^2, 
 1/2 λ8 Abs[Φ2]^2 Abs[ΦS]^2, 
 1/8 λ6 Abs[ΦS]^4, 
 1/2 λ5 Φ2^2 Conjugate[Φ1]^2, 
 1/2 λ5 Φ1^2 Conjugate[Φ2]^2} *)

Answer 2

A classic way is to scale each variable by a dummy variable, say, k. Then the coefficient of k^n consists of all the degree n terms. The appearance of Abs[] and Conjugate[] means this is not strict a polynomial problem, and we have to add a step to factor the k out from from them. (Mathematically, one may assume k > 0, but Full/Simplify do not always think the form with k factored out of Abs[] etc is "simpler.")

scaled = potential /. 
    v : \[CapitalPhi]1 | \[CapitalPhi]2 | \[CapitalPhi]S :> k*v /.
  (h : Abs | Conjugate)[(kk : k^_.) * rest_] :> kk * h[rest];
Coefficient[scaled, k^4] // MonomialList // Sort
(* nine monomials
{1/2  \[Lambda]1  Abs[\[CapitalPhi]1]^4,
 \[Lambda]3  Abs[\[CapitalPhi]1]^2  Abs[\[CapitalPhi]2]^2,
 1/2  \[Lambda]2  Abs[\[CapitalPhi]2]^4,
 \[Lambda]4  Abs[\[CapitalPhi]1 \[CapitalPhi]2]^2,
 1/2  \[Lambda]7  Abs[\[CapitalPhi]1]^2  Abs[\[CapitalPhi]S]^2,
 1/2  \[Lambda]8  Abs[\[CapitalPhi]2]^2  Abs[\[CapitalPhi]S]^2,
 1/8  \[Lambda]6  Abs[\[CapitalPhi]S]^4,
 1/2  \[Lambda]5  \[CapitalPhi]2^2  Conjugate[\[CapitalPhi]1]^2,
 1/2  \[Lambda]5  \[CapitalPhi]1^2  Conjugate[\[CapitalPhi]2]^2}
*)