# Making a list of rules from the list of elements

Starting from the list:

{f[q1, q2], f[q3, q4], g[q1], g[q2, q3, q4], d[k1 - q1], d[k2 - q2 - q3 -q4]}

I would like to get the result:

{f[q1, q2] -> g[q1], f[q1, q2] -> g[q2, q3, q4], f[q3, q4] -> g[q2, q3, q4], f[q3, q4] -> g[q2, q3, q4], g[q1] -> k1, g[q2, q3, q4] -> k2}

by applying following two rules: first for all $q_i$ variables match $f[]$ to $g[]$ that contain the same $q_i$. If $f[]$ and $g[]$ contain more then one $q_i$ that is the same, then repeat the rule for each of such $q_i$, as in case of

f[q3, q4] -> g[q2, q3, q4]

Second rule should mach $g[]$ to a given $k_i$ that are again related by the corresponding $q_j$ in $d[]$ element. In case of multiple $q_j$ relating $g[]$ to a given $k_i$ only one rule will suffice, as in case of

g[q2, q3, q4] -> k2

How do I make a function that would produce such a list of rules for a given input list?

Note: Element $d[...]$ in the input list can be thought of as a delta function setting the external momenta.

Eventually I want to use the obtained rules to make a GraphPlot that corresponds to the Feynman diagram. Repeated rules then correspond to loops in a diagram.

• Hi, welcome to Mathematica.SE, please consider taking the tour so you learn the basics of the site. Once you gain enough reputation by making good questions you will be able to vote up and down both questions and answers. When you see good ones, please vote them up by clicking the grey triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. As you receive help, try to give it too, by answering questions in your area of expertise. Oct 29, 2014 at 10:04
• There are things to do after your question has been answered, but don't rush, you may want stay vigilant some time after you get the first answer as its is likely that the best approaches may come later improving over a previous reply. Therefore, its a good idea to wait a few hours before voting the deserving answers and accepting the best one for you. (Links contain useful information)) Oct 29, 2014 at 16:51

ClearAll[f, g, q1, q2, q3, d, k1, k2]

flist = {f[q1, q2], f[q3, q4], g[q1], g[q2, q3, q4], d[k1 - q1], d[k2 - q2 - q3 - q4]}

## First set of rules

Without repeated rules

Make a list of all possible combinations of f[_] and g[_] using Tuples, then Select the ones with IntersectingQ arguments, and change Head from List to Rule using Apply (@@, @@@)

Rule @@@ Select[
Tuples[
{
}],
IntersectingQ[List @@ #[[1]], List @@ #[[2]]] &
]
{f[q1, q2] -> g[q1], f[q1, q2] -> g[q2, q3, q4], f[q3, q4] -> g[q2, q3, q4]}

With repeated rules

Make a list of all possible combinations of f[_] and g[_] using Tuples, then repeat each combination the number of common arguments. Then change Head from List to Rule using Apply (@@, @@@)

Rule @@@ Flatten[
Table[#, {Length[Intersection[List @@ #[[1]], List @@ #[[2]]]]}] & /@

## Second set of rules

Now depending how the second set of rules is defined:

If by the arguments in g[_]:

Select the g[_], take the fist argument and replace "q" for "k" , and change Head from List to Rule using Apply (@@@)

Rule @@@ (
{#, ToExpression@
StringReplace[ToString[First[List @@ #]], "q" -> "k"]} & /@
)

If by the arguments in d[_]:

Block[{dlist = Select[flist, Head[#] == d &], arglist, ks, gs},
arglist = First /@ List @@@ dlist;
ks = Select[#, StringMatchQ[ToString[#], "k" ~~ __] &] & /@ arglist;
gs = If[ListQ[#], g @@ #, g@#] & /@ (List @@@ (ks - arglist));
Rule @@@ Transpose[{gs, ks}]
]
{g[q1] -> k1, g[q2, q3, q4] -> k2}

Now you can just join the two lists of Rules

• The arguments by d[_] is what I had in mind... sorry for the confusion.
– z.v.
Oct 29, 2014 at 15:32
• In the 'First set of rules' the rule f[q3, q4] -> g[q2, q3, q4] should appear twice since there are two q-s that are matched.
– z.v.
Oct 29, 2014 at 17:37
• I want to use rules to make a GraphPlot. Repeated rule then corresponds to a loop in the Feynman diagram i'm trying to construct.
– z.v.
Oct 29, 2014 at 17:41