In[]:=
ClearAll["Global`*"]
(Debug) (Dialog) In[]:=
ver4c={X42,X43};​​B4B=
1
16
t(
4
m1
t+
4
m2
t+t
2
(s+t-X42)
-2
2
m2
(st+(t-2X42)(t-X42-X43))-2
2
m1
(
2
m2
t+st+(t-2X43)(t-X42-X43))-2t(s+t)X43+2(2s+t)X42X43+t
2
X43
);​​​​B4B=
1
16
t(
4
m1
t+
4
m2
t+t
2
(s+t-X42)
-2
2
m2
(st+(t-2X42)(t-X42-X43))-2
2
m1
(
2
m2
t+st+(t-2X43)(t-X42-X43))-2t(s+t)X43+2(2s+t)X42X43+t
2
X43
)​​​​
1
16
t(
4
m1
t+
4
m2
t+t
2
(s+t-X42)
-2
2
m2
(st+(t-2X42)(t-X42-X43))-2
2
m1
(
2
m2
t+st+(t-2X43)(t-X42-X43))-2t(s+t)X43+2(2s+t)X42X43+t
2
X43
)​​
(Debug) (Dialog) Out[]=
1
16
t(
4
m1
t+
4
m2
t+t
2
(s+t-X42)
-2
2
m2
(st+(t-2X42)(t-X42-X43))-2
2
m1
(
2
m2
t+st+(t-2X43)(t-X42-X43))-2t(s+t)X43+2(2s+t)X42X43+t
2
X43
)
(Debug) (Dialog) Out[]=
1
16
t(
4
m1
t+
4
m2
t+t
2
(s+t-X42)
-2
2
m2
(st+(t-2X42)(t-X42-X43))-2
2
m1
(
2
m2
t+st+(t-2X43)(t-X42-X43))-2t(s+t)X43+2(2s+t)X42X43+t
2
X43
)
(Debug) (Dialog) In[]:=
ureg4c=Product[ver4c[[i]]^rho4[i],{i,1,2}]*B4B^((d-5)/2)
(Debug) (Dialog) Out[]=
5-d
4
rho4[1]
X42
rho4[2]
X43
1
2
(-5+d)
(t(
4
m1
t+
4
m2
t+t
2
(s+t-X42)
-2
2
m2
(st+(t-2X42)(t-X42-X43))-2
2
m1
(
2
m2
t+st+(t-2X43)(t-X42-X43))-2t(s+t)X43+2(2s+t)X42X43+t
2
X43
))
In[]:=
uregnum4c=ureg4c/.{s:>17,t:>23,m1:>37,m2:>43,d:>1/97,rho[1]:>1/113,rho[2]:>1/149,rho[3]:>1/173,rho[4]:>1/197};
In[]:=
dlist4c=Table[FullSimplify[D[Log[uregnum4c],ver4c[[i]]]],{i,1,Length[ver4c]}];
In[]:=
EQSuc=Table[dlist4c[[i]]==0,{i,1,Length[ver4c]}];
In[]:=
SOLc=Solve[EQSuc,ver4c];
In[]:=
lenSOL=Length[SOLc]
Out[]=
4
In[]:=
subsets4c=Subsets[ver4c]
Out[]=
{{},{X42},{X43},{X42,X43}}
In[]:=
Do[​​currentvars4c=subsets4c[[k]];​​remvars4c=Join[Complement[ver4c,currentvars4c],{s,t,d,m1,m2,rho3[1],rho3[2],rho3[3],rho3[4]}];​​numrules4c=Table[remvars4c[[i]]->1/Prime[23+45*i],{i,Length[remvars4c]}];​​dlistdo4c=Table[Simplify[D[Log[ureg4c/.numrules4c],currentvars4c[[j]]]],{j,1,Length[currentvars4c]}];​​SOLdo4c=Solve[dlistdo4c==0,currentvars4c];​​lenSOLdo4c=Length[SOLdo4c];​​Print[k,"/",Length[subsets4c]," ",currentvars4c," ",lenSOLdo4c];​​,{k,2,Length[subsets4c]}];​​
2/4 {X42} 2
3/4 {X43} 2
4/4 {X42,X43} 4
Do[​​currentvars4c=Take[ver4c,ii];​​Print["\nFor set ",currentvars4c," :"];​​remvars4c=Join[Complement[ver4c,currentvars4c],{s,t,d,m1,m2,rho4[1],rho4[2],rho4[3],rho4[4]}];​​numrules4c=Table[remvars4c[[i]]->1/Prime[23+45*i],{i,Length[remvars4c]}];​​Do[​​currentset4c=subsets4c[[k]];​​ureg42c=Product[currentset4c[[i]]^rho4[i],{i,1,Length[currentset4c]}]*B4B^((d-5)/2);​​ureg42c=ureg42c/.numrules4c;​​dlistdo4c=Table[Simplify[D[Log[ureg42c],currentvars4c[[j]]]],{j,1,Length[currentvars4c]}];​​SOLdo4c=Solve[dlistdo4c==0,currentvars4c];​​Length[SOLdo4c];​​lenSOLdo4c=Length[SOLdo4c];​​Print[k,"/",Length[subsets4c]," ",currentset4c," ",lenSOLdo4c];​​,{k,1,Length[subsets4c]}];​​,{ii,1,Length[ver4c]}];
For set {X42} :
1/4 {} 1
2/4 {X42} 2
3/4 {X43} 1
4/4 {X42,X43} 2
For set {X42,X43} :
1/4 {} 1
2/4 {X42} 2
3/4 {X43} 2
4/4 {X42,X43} 4