That works, you're right
In[4]:=
n = 50;
d1 = 10;
d2 = 15;
d3 = 16;
Y = 1000000;
r = Reduce[
p0 + p1 + p2 + p3 + p100 == 1 && p0 >= 0 && p1 >= 0 && p2 >= 0 &&
p3 >= 0 && p100 >= 0 &&
p0^n + n*p0^(n - 1)*p1 + n*p0^(n - 1)*p2 + n*p0^(n - 1)*p3 "4" +
n*(n - 1)/2*p0^(n - 2)*p1^2 + n*(n - 1)*p0^(n - 2)*p1*p2 +
n*(n - 1)/2*p0^(n - 2)*p2^2 +
n*(n - 1) p0^(n - 2)*p1*p3 "8" + n (n - 1) p0^(n - 2)*p2*p3 +
n (n - 1) (n - 2)/6*p0^(n - 3) p1^3 +
n (n - 1) (n - 2)/2*p0^(n - 3)*p1^2*p2 "11" +
n (n - 1) (n - 2)/2*p0^(n - 3)*p1*p2^2 +
n (n - 1) (n - 2)/2*p0^(n - 3)*p1^2*p3 +
n (n - 1) (n - 2) p0^(n - 3)*p1*p2*p3
== 1/20, {p0, p1, p2, p3, p100}, Reals,
Backsubstitution -> True];
q = NMaximize[{Y/100*(0*p0 + d1*p1 + d2*p2 + d3*p3 + 100*p100),
r}, {p0, p1, p2, p3, p100}]
},
{\[Placeholder]}
}
During evaluation of In[4]:= Reduce::nsmet: This system cannot be solved with the methods available to Reduce.
During evaluation of In[4]:= Reduce::nsmet: This system cannot be solved with the methods available to Reduce.
During evaluation of In[4]:= Reduce::ivar: 0.6565924971797801` is not a valid variable.
During evaluation of In[4]:= NMaximize::bcons: The following constraints are not valid: {Reduce[{p0+p1+p100+p2+p3==1,p0>=0,p1>=0,p2>=0,p3>=0,p100>=0,p0^50+50 p0^49 p1+1225 p0^48 p1^2+19600 p0^47 p1^3+50 p0^49 p2+2450 p0^48 p1 p2+58800 11 p0^47 p1^2 p2+1225 p0^48 p2^2+58800 p0^47 p1 p2^2+50 4 p0^49 p3+2450 8 p0^48 p1 p3+58800 p0^47 p1^2 p3+2450 p0^48 p2 p3+117600 p0^47 p1 p2 p3==1/20},{p0,p1,p2,p3,p100},\[DoubleStruckCapitalR],Backsubstitution->True]}. Constraints should be equalities, inequalities, or domain specifications involving the variables.
Out[4]= {{"n=101;\[IndentingNewLine]d1=25;\[IndentingNewLine]d2=75;\
\[IndentingNewLine]s=0;\[IndentingNewLine]Y=1000000;\
\[IndentingNewLine]r=Reduce[a+b+c+d\[Equal]1&& a\[GreaterEqual]0&&b\
\[GreaterEqual]0&&c\[GreaterEqual]0&&d\[GreaterEqual]0\
&&\[IndentingNewLine]a^n+n*a^(n-1)*b+n*a^(n-1)*c+n*(n-1)*a^(n-2)*b*c+\
n*(n-1)/2*a^(n-2)*b^2==1/20,{a,b,c,d},Reals,Backsubstitution\[Rule]\
True];\[IndentingNewLine]q=NMaximize[{Y/100*(0*a+d1*b+d2*c+100*d),r},{\
a,b,c,d}];\[IndentingNewLine]l=q+s" Null^6 NMaximize[{10000 (10 p1 +
100 p100 + 15 p2 + 16 p3),
ce[p0 + p1 + p100 + p2 + p3 == 1 && p0 >= 0 && p1 >= 0 &&
p2 >= 0 && p3 >= 0 && p100 >= 0 &&
p0^50 + 50 p0^49 p1 + 1225 p0^48 p1^2 + 19600 p0^47 p1^3 +
50 p0^49 p2 + 2450 p0^48 p1 p2 + 58800 "11" p0^47 p1^2 p2 +
1225 p0^48 p2^2 + 58800 p0^47 p1 p2^2 + 50 "4" p0^49 p3 +
2450 "8" p0^48 p1 p3 + 58800 p0^47 p1^2 p3 +
2450 p0^4qrt[7)^n - (8 + 3 Sqrt[7])^n)/(2 Sqrt[7]))
In[46]:= With[{l = RandomInteger[{1, 2^16}, 17]},
Print["l: ", l];
And @@ (IntegerQ /@ FullSimplify[Expand[x[#]] & /@ l])
]
During evaluation of In[46]:= l: {8309,55053,28081,62999,49730,51523,40250,65370,30882,4898,16978,48880,6337,6133,9837,26546,49300}
Out[46]= True
In[47]:= With[{l = RandomInteger[{1, 2^16}, 17]},
Print["l: ", l];
And @@ (IntegerQ /@ FullSimplify[Expand[y[#]] & /@ l])
]
During evaluation of In[47]:= l: {447,23621,25471,49476,26678,6573,60939,63208,56458,51985,24444,34525,59990,12914,10239,64048,34724}
Out[47]= True
thank you.
It has to work because in
$x$ the odd powers of
$\sqrt{7}$ cancel out as well in
$y$ the even powers of
$\sqrt{7}$ cancel out and in
$y$ a division by
$\sqrt{7}$ follows:
$x$ and
$y$ are both root-free. The factor
$\frac{1}{2}$ does also not create a rational number, because the previous step brought a factor 2 in the numerator.
