https://reference.wolfram.com/language/ref/SeedRandom.html

Thank you for your reply. Correct me please if I'm wrong. So for each random search it sets up the random starting points to all p and searches the minimum up to the 1 for all p variables and objective function. But I have another question, what is the seed in this case? Is it an extra starting point from 0 to 1 for all p? Why is it set up on zero? Regards, Alex

1)I did the calculation with multiple random searches, using ParametricIPOPTMinimize, using the starting values as the parameters. I got the result I posted for 10, 100, and 1000 random searches. 2)Thank you for your reply. I have one specializing question. [{{p0, p1, p2, p3, p100}, 0, 1}], 10, 0] 0,1 means it is searching within the 0:1 interval, 10 means number of serches. What does 0] mean? 3)the final input, 0, is the seed for the 10 random searches.

Seems some time has passed away since I was on the thread. I've got what I wanted, but still have some questions about minimization process itself. If I get it right, the seed is the point for all p0,p1,p2,p3,p100. And it finds the minimum checking the function from the 0 to 1 for all p. So my question are 1) Do the algorithm start to find minimum for all p0=p1=p2=p3=p4=p100=0 at the same time or take only p0=0 and finds some minimum, then take only p1=0 finds some minimum and so on? 2) If the seed is the same for all random searches, so searches are the same or not? If they are not the same what is the difference between them? Why we need several of them but not only one? Thanks in advance.

rerunning with several different random seeds gave the same result

Hello again. I've made a program to generate the set of outcomes depending on errors. So I'm sure that 99% that it's correct. So I've tried to find probabilities for 4 mistakes. And got these results. This means that the probabilities for having a error with d1,d2,d4 are zero, that it's not ok in theory or not(i'm not sure). What do you think on it? Anyway, thanks for all.

Seems my modified code dosent work with FindMaximum and Imin without reduction, because the equation output is turning out with brakets.

Thank you for the explanation.

using the code at http://community.wolfram.com/groups/-/m/t/1164680 and changing the sign of the objective function, since the code does minimization:

In[11]:= n = 56;
d1 = 10;
d2 = 15;
d3 = 16;
Y = 1000000;

In[18]:= iMin[-Y/100*(0*p0 + d1*p1 + d2*p2 + d3*p3 + 100*p100), 
 List @@ (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 + 
      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 + 
      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 + 
      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), Thread[{{p0, p1, p2, p3, p100}, 0, 1}], 10, 0]

During evaluation of In[18]:= {{Infeasible_Problem_Detected,8},{Solve_Succeeded,2}}

Out[18]= {-53920.9, {p0 -> 0.925934, p1 -> 0.0127001, p2 -> 0.0099051,
   p3 -> 0.000352082, p100 -> 0.0511088}}

In[3]:= n = 56;
d1 = 10;
d2 = 15;
d3 = 16;
Y = 1000000;

In[13]:= FindMaximum[{Y/100*(0*p0 + d1*p1 + d2*p2 + d3*p3 + 100*p100),
   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 + 
     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 + 
     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 + 
     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, .925}, {p1, .013}, {p2, .01}, {p3, 
   0}, {p100, .05}}]

Out[13]= {53920.9, {p0 -> 0.925934, p1 -> 0.0127001, p2 -> 0.0099051, 
  p3 -> 0.000352085, p100 -> 0.0511088}}

1)I did the calculation with multiple random searches, using ParametricIPOPTMinimize, using the starting values as the parameters. I got the result I posted for 10, 100, and 1000 random searches. 2)Thank you for your reply. I have one specializing question. [{{p0, p1, p2, p3, p100}, 0, 1}], 10, 0] 0,1 means it is searching within the 0:1 interval, 10 means number of serches. What does 0] mean? 3)the final input, 0, is the seed for the 10 random searches. Seems some time has passed away since I was on the thread. I've got what I wanted, but still have some questions about minimization process itself. If I get it right, the seed is the point for all p0,p1,p2,p3,p100. And it finds the minimum checking the function from the 0 to 1 for all p. So my question are 1) Do the algorithm start to find minimum for all p0=p1=p2=p3=p4=p100=0 at the same time or take only p0=0 and finds some minimum, then take only p1=0 finds some minimum and so on? 2) If the seed the same for all random searches, so searches are the same or not? If they are not the same what is the difference between them? Why we need several of them but not only one? Thanks in advance.

I tried doing the problem with some experimental code I've been writing and got

{53920.9, {p0 -> 0.925934, p1 -> 0.0127001, p2 -> 0.00990509, 
  p3 -> 0.000352097, p100 -> 0.0511088}

Does that solution make sense?

Year. sorry this was my mistake. I dont think that these comments will brake reduce function. Now, I have NMaximizing function dosent work for a large n.

I defined a function that could help;

KTEqs[obj_, cons_List, vars_] :=
 Module[{consconvrule = {GreaterEqual[x_, y_] -> LessEqual[y - x, 0], 
     Equal[x_, y_] -> Equal[x - y, 0], 
     LessEqual[x_, y_] -> LessEqual[x - y, 0],
     LessEqual[lb_, x_, ub_] -> LessEqual[(x - lb) (x - ub), 0], 
     GreaterEqual[ub_, x_, lb_] -> LessEqual[(x - lb) (x - ub), 0]} 
    , stdcons, eqcons, ineqcons, lambdas, mus, lagrangian, eqs1, eqs2,
    eqs3, alleqns, allvars },
  stdcons = cons /. consconvrule;
  eqcons = Cases[stdcons, Equal[_, 0]][[All, 1]];
  ineqcons = Cases[stdcons, LessEqual[_, 0]][[All, 1]];
  lambdas = Array[\[Lambda], Length[eqcons]];
  mus = Array[\[Mu], Length[ineqcons]];
  lagrangian = obj + lambdas.eqcons + mus.ineqcons;
  eqs1 = Thread[ D[lagrangian, {vars}] == 0];
  eqs2 = Thread[mus >=   0];
  eqs3 = Thread[mus*ineqcons == 0];
  alleqns = Join[eqs1, eqs2, eqs3, cons];
  allvars = Join[vars, lambdas, mus];
  {alleqns, allvars}
  ]

KTMinimize[obj_, cons_List, vars_List] :=
 Block[{kteqs, r, rls, objvals, minobj, objrls, res},
  kteqs = KTEqs[obj, cons, vars];
  r = LogicalExpand @  
    Reduce[Sequence @@ kteqs, Backsubstitution -> True, 
     Cubics -> True, Quartics -> True];

  If[Head[r] === And,
   rls = List @@ ToRules[r];
   objvals = obj /. rls;
   res = {objvals, rls},
   (* Else *)
   rls = List @@ (ToRules /@ r);
   objvals = obj /. rls;
   minobj = Min[objvals];
   objrls = Thread[{objvals, rls}];
   res = Select[objrls, #[[1]] == minobj &];
   If[Length[res] == 1, res = res[[1]]];
   ];

  res
  ]

In[3]:= AbsoluteTiming[
 KTMinimize[-1000000/100*(25*b + 75*c + 100*(1 - a - b - c)), {a >= 0,
     b >= 0, c >= 0, 
    a^101 + 101*a^100*b + 101*a^100*c + 101*100*a^99*b*c + 
      50*100*a^99*b^2 >= 1/20}, {a, b, c}] // N]

Out[3]= {3.48344, {-35843.9, {a -> 0.953819, b -> 0.00444532, 
   c -> 0.028011, \[Mu][1.] -> 
    3.42892*10^-10, \[Mu][2.] -> -5.08376*10^-10, \[Mu][3.] -> 
    5.66923*10^-10, \[Mu][4.] -> 190922.}}}

Thanks for your reply. Just one techical quistion, I think this should be last question for now. Is it possible to get more cleaner output without nulls and placeholder?

In[9]:= {
 {n = 101;
  d1 = 25;
  d2 = 75;
  s = 20000;
  Y = 1000000;
  r = Reduce[
     a + b + c + d == 1 && a >= 0 && b >= 0 && c >= 0 && d >= 0 &&
      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 -> True];
  q = NMaximize[{Y/100*(0*a + d1*b + d2*c + 100*d), r}, {a, b, c, d}];
  l = q + s


  },
 {\[Placeholder]}
}

During evaluation of In[9]:= NMaximize::incst: NMaximize was unable to generate any initial points satisfying the inequality constraints {(101 a-Sqrt[101] Sqrt[Power[<<2>>] Plus[<<2>>]])/10100+b<=0}. The initial region specified may not contain any feasible points. Changing the initial region or specifying explicit initial points may provide a better solution.

Out[9]= {{{55845.7 Null^7, {Null^7 (20000 + (a -> 0.953808)), 
    Null^7 (20000 + (b -> 0.00446185)), 
    Null^7 (20000 + (c -> 0.0279999)), 
    Null^7 (20000 + (d -> 0.0137303))}}}, {\[Placeholder]}}

Thanks guys for your replies! Could you give me some more advice on how to use the results for a,b,c... from Nmaximize or findmaximum in one input? I've tried to make like this

r = FindMaximum[{1000000/100*(25*b + 75*c + 100*(1 - a - b - c)), 
   a >= 0 && b >= 0 && c >= 0 && 
    a^101 + 101*a^100*b + 101*a^100*c + 101*100*a^99*b*c + 
      50*100*a^99*b^2 == 1/20}, {{a, 0.95}, {b, 0.004}, {c, 0.03}}]
s = 50 + a /. [[2]] + b /. [[3]]

But it seems to be working only with solve equation and I also tried to use the other way

{a, b, c} = 
  With[{r = 
     FindMaximum[{1000000/100*(25*b + 75*c + 100*(1 - a - b - c)), 
       a >= 0 && b >= 0 && c >= 0 && 
        a^101 + 101*a^100*b + 101*a^100*c + 101*100*a^99*b*c + 
          50*100*a^99*b^2 == 1/20}, {{a, 0.95}, {b, 0.004}, {c, 
        0.03}}]}, Extract[r, Position[r, _?NumericQ]]];
s = 50 + a + b

But both without success. Thanks in advance!

If you substitute 1-a-b-c for d, remove the unnecessary 0*a, use better starting values, and use FindMaximum, you'll get the following very quickly:

FindMaximum[{1000000/100*(25*b + 75*c + 100*(1 - a - b - c)),  a >= 0 && b >= 0 && c >= 0 &&
   a^101 + 101*a^100*b + 101*a^100*c + 101*100*a^99*b*c + 50*100*a^99*b^2 >= 1/20}, 
   {{a, 0.95}, {b, 0.004}, {c, 0.03}}]

(* {35843.9, {a -> 0.953819, b -> 0.00444532, c -> 0.028011}} *)

In[8]:= r = 
  Reduce[a + b + c + d == 1 && a >= 0 && b >= 0 && c >= 0 && d >= 0 &&
     a^101 + 101*a^100*b + 101*a^100*c + 101*100*a^99*b*c + 
      50*100*a^99*b^2 >= 1/20, {a, b, c, d}, Reals, 
   Backsubstitution -> True];

In[9]:= FindMaximum[{1000000/100*(0*a + 25*b + 75*c + 100*d), r}, {a, 
  b, c, d}]

Out[9]= {34580.5, {a -> 0.953893, b -> 0., c -> 0.0461073, d -> 0.}}

Note that I changed 0.05 to 1/20 to give Reduce an infinite precision input