|
|
MATHEMATICA
|
pN[p_] := Total[p]!/Times@@p/Times@@Factorial[Flatten[Tally[p]][[2 ;; ;; 2]]]
oddQ[p_] := OddQ[Total[p - 1]]
ord[p_] := LCM @@ p
oriN[p_, o_] := Module[{i, t, a = 0, ns = 0, s = 0, r}, t = ord[p]/p;
For[i = 1, i <= Length[p], i++,
If[Mod[t[[i]], o] == 0, a += p[[i]], ns += 1; s += p[[i]]]];
{If[a == 0, r = o^(s - ns), r = o^a o^(s - ns - 1)], o^(a + s - 1) - r}]
val[p1_, o1_, p2_, o2_] :=
Module[{z}, z = pN[p1] pN[p2];
{{LCM[ord[p1], ord[p2]], z oriN[p1, o1][[1]] oriN[p2, o2][[1]]},
{{LCM[ord[p1] o1, ord[p2]], z oriN[p1, o1][[2]] oriN[p2, o2][[1]]}}, {{LCM[ord[p1], ord[p2] o2], z oriN[p1, o1][[1]] oriN[p2, o2][[2]]}},
{{LCM[ord[p1] o1, ord[p2] o2], z oriN[p1, o1][[2]] oriN[p2, o2][[2]] }}}]
p8 = IntegerPartitions[8]; p12 = IntegerPartitions[12];
ce = Select[p8, ! oddQ[#] &]; co = Select[p8, oddQ[#] &];
ee = Select[p12, ! oddQ[#] &]; eo = Select[p12, oddQ[#] &];
res = {}; max = 0;
For[i = 1, i <= Length[ce], i++,
For[j = 1, j <= Length[ee], j++,
AppendTo[res, val[ce[[i]], 3, ee[[j]], 2]]]]
For[i = 1, i <= Length[co], i++,
For[j = 1, j <= Length[eo], j++,
AppendTo[res, val[co[[i]], 3, eo[[j]], 2]]]]
p = Partition[res // Flatten, 2]; c // Clear;
For[i = 1, i <= Length[p], i++,
If [IntegerQ[c[p[[i, 1]]]], c[p[[i, 1]]] += p[[i, 2]],
c[p[[i, 1]]] = p[[i, 2]]]; If[p[[i, 1]] > max, max = p[[i, 1]]]];
Select[Table[c[i], {i, 1, max}], IntegerQ[#] &] (* Herbert Kociemba, Jun 30 2022 *)
|
