Skip to main content
added 7 characters in body
Source Link
Xavier
  • 103
  • 3

This code solves the problem:

(*assignments*) 
indiceLength = 6; fields = {X, Y};
expr = F[a, b, c, d, e, f] (X[a] Y[c, d] + X[d] Y[a, c]) (X[b] Y[e, f] + X[e] Y[f, b]) //Expand;
indices = Take[CharacterRange["a", "z"], indiceLength] // ToExpression;

(*find the*temporary permutationindices of the indices*fields*)
temporaryIndices[fieldsTemp_] := 
  fieldsTemp /. ((# -> List) & /@ fields) // Flatten;

(*including all possible combinations for the same type of fields*)
interchanges[a_, b_, c_, d_, e_, f_] := Module[{permuteX, permuteY},
   permuteX = Permutations[{a, b}];
   permuteY = Permutations[{{c, d}, {e, f}}];
   Partition[
    Flatten[Outer[Join, permuteX, permuteY, 1]], 6]indiceLength]
   ];
(*set the rule*)
rule[fieldsTemp_] :=
 Thread[indices -> #] & /@
  (Permute[indices, #] & /@
    ((FindPermutation[#, indices]) & /@
      interchanges[Sequence @@ temporaryIndices[fieldsTemp]]))

(*the result*)
(Plus @@ (# /. rule[Cases[#, X[__] | Y[__]]])) & /@ expr;
DeleteCases[%, X[_] | Y[__], Infinity]

The result is

F[a, b, c, d, e, f] + F[a, b, e, f, c, d] + F[a, d, e, f, b, c] + 
 F[a, f, c, d, b, e] + F[b, a, c, d, e, f] + F[b, a, e, f, c, d] + 
 F[b, d, e, f, a, c] + F[b, f, c, d, a, e] + F[c, a, d, b, e, f] + 
 F[c, b, d, a, e, f] + F[c, f, d, a, b, e] + F[c, f, d, b, a, e] + 
 F[e, a, f, b, c, d] + F[e, b, f, a, c, d] + F[e, d, f, a, b, c] + 
 F[e, d, f, b, a, c]

This code solves the problem:

(*assignments*) 
indiceLength = 6; fields = {X, Y};
expr = F[a, b, c, d, e, f] (X[a] Y[c, d] + X[d] Y[a, c]) (X[b] Y[e, f] + X[e] Y[f, b]) //Expand;
indices = Take[CharacterRange["a", "z"], indiceLength] // ToExpression;

(*find the permutation of the indices*)
temporaryIndices[fieldsTemp_] := 
  fieldsTemp /. ((# -> List) & /@ fields) // Flatten;

(*including all possible combinations for the same type of fields*)
interchanges[a_, b_, c_, d_, e_, f_] := Module[{permuteX, permuteY},
   permuteX = Permutations[{a, b}];
   permuteY = Permutations[{{c, d}, {e, f}}];
   Partition[
    Flatten[Outer[Join, permuteX, permuteY, 1]], 6]
   ];
(*set the rule*)
rule[fieldsTemp_] :=
 Thread[indices -> #] & /@
  (Permute[indices, #] & /@
    ((FindPermutation[#, indices]) & /@
      interchanges[Sequence @@ temporaryIndices[fieldsTemp]]))

(*the result*)
(Plus @@ (# /. rule[Cases[#, X[__] | Y[__]]])) & /@ expr;
DeleteCases[%, X[_] | Y[__], Infinity]

The result is

F[a, b, c, d, e, f] + F[a, b, e, f, c, d] + F[a, d, e, f, b, c] + 
 F[a, f, c, d, b, e] + F[b, a, c, d, e, f] + F[b, a, e, f, c, d] + 
 F[b, d, e, f, a, c] + F[b, f, c, d, a, e] + F[c, a, d, b, e, f] + 
 F[c, b, d, a, e, f] + F[c, f, d, a, b, e] + F[c, f, d, b, a, e] + 
 F[e, a, f, b, c, d] + F[e, b, f, a, c, d] + F[e, d, f, a, b, c] + 
 F[e, d, f, b, a, c]

This code solves the problem:

(*assignments*) 
indiceLength = 6; fields = {X, Y};
expr = F[a, b, c, d, e, f] (X[a] Y[c, d] + X[d] Y[a, c]) (X[b] Y[e, f] + X[e] Y[f, b]) //Expand;
indices = Take[CharacterRange["a", "z"], indiceLength] // ToExpression;

(*temporary indices of the fields*)
temporaryIndices[fieldsTemp_] := 
  fieldsTemp /. ((# -> List) & /@ fields) // Flatten;

(*including all possible combinations for the same type of fields*)
interchanges[a_, b_, c_, d_, e_, f_] := Module[{permuteX, permuteY},
   permuteX = Permutations[{a, b}];
   permuteY = Permutations[{{c, d}, {e, f}}];
   Partition[
    Flatten[Outer[Join, permuteX, permuteY, 1]], indiceLength]
   ];
(*set the rule*)
rule[fieldsTemp_] :=
 Thread[indices -> #] & /@
  (Permute[indices, #] & /@
    ((FindPermutation[#, indices]) & /@
      interchanges[Sequence @@ temporaryIndices[fieldsTemp]]))

(*the result*)
(Plus @@ (# /. rule[Cases[#, X[__] | Y[__]]])) & /@ expr;
DeleteCases[%, X[_] | Y[__], Infinity]

The result is

F[a, b, c, d, e, f] + F[a, b, e, f, c, d] + F[a, d, e, f, b, c] + 
 F[a, f, c, d, b, e] + F[b, a, c, d, e, f] + F[b, a, e, f, c, d] + 
 F[b, d, e, f, a, c] + F[b, f, c, d, a, e] + F[c, a, d, b, e, f] + 
 F[c, b, d, a, e, f] + F[c, f, d, a, b, e] + F[c, f, d, b, a, e] + 
 F[e, a, f, b, c, d] + F[e, b, f, a, c, d] + F[e, d, f, a, b, c] + 
 F[e, d, f, b, a, c]
Source Link
Xavier
  • 103
  • 3

This code solves the problem:

(*assignments*) 
indiceLength = 6; fields = {X, Y};
expr = F[a, b, c, d, e, f] (X[a] Y[c, d] + X[d] Y[a, c]) (X[b] Y[e, f] + X[e] Y[f, b]) //Expand;
indices = Take[CharacterRange["a", "z"], indiceLength] // ToExpression;

(*find the permutation of the indices*)
temporaryIndices[fieldsTemp_] := 
  fieldsTemp /. ((# -> List) & /@ fields) // Flatten;

(*including all possible combinations for the same type of fields*)
interchanges[a_, b_, c_, d_, e_, f_] := Module[{permuteX, permuteY},
   permuteX = Permutations[{a, b}];
   permuteY = Permutations[{{c, d}, {e, f}}];
   Partition[
    Flatten[Outer[Join, permuteX, permuteY, 1]], 6]
   ];
(*set the rule*)
rule[fieldsTemp_] :=
 Thread[indices -> #] & /@
  (Permute[indices, #] & /@
    ((FindPermutation[#, indices]) & /@
      interchanges[Sequence @@ temporaryIndices[fieldsTemp]]))

(*the result*)
(Plus @@ (# /. rule[Cases[#, X[__] | Y[__]]])) & /@ expr;
DeleteCases[%, X[_] | Y[__], Infinity]

The result is

F[a, b, c, d, e, f] + F[a, b, e, f, c, d] + F[a, d, e, f, b, c] + 
 F[a, f, c, d, b, e] + F[b, a, c, d, e, f] + F[b, a, e, f, c, d] + 
 F[b, d, e, f, a, c] + F[b, f, c, d, a, e] + F[c, a, d, b, e, f] + 
 F[c, b, d, a, e, f] + F[c, f, d, a, b, e] + F[c, f, d, b, a, e] + 
 F[e, a, f, b, c, d] + F[e, b, f, a, c, d] + F[e, d, f, a, b, c] + 
 F[e, d, f, b, a, c]