1
$\begingroup$ 
   (* structural entropy for N=3 *)
 S[p1_, p2_, p3_] := (   
         p1 + p2 + p3 == 1;
         S1 = -(p1*Log[p1] + p2*Log[p2] + p3*Log[p3]);
         S2 = -Log[(p1^2 + p2^2 + p3^2)];  
         Sstr = S1 - S2   )
    
    NMaximize[{S[p1, p2, p3], 0 <= p1 <= 1, 0 <= p2 <= 1, 0 <= p3 <= 1, p1 + p2 + p3 == 1}, 
    {p1, p2, p3}]

I get

{0.137934, {p1 -> 0.0320363, p2 -> 0.0223545, p3 -> 0.945609}}

while

S[0.806, 0.097, 0.097]

you can get

0.223654

So I believe 0.137934 is not the maximum value

Improve this question
$\endgroup$
2
  • $\begingroup$ p1, p2, p3 are not linearly independent . you may replace p3 by 1 - p1 - p2 . Further, the value of S can be complex for 0 < {p1, p2} < 1. Therefore, there is no maximum . You must restrict p1 and p2 further to ensure a real value of S. $\endgroup$
    – Daniel Huber
    Aug 28, 2022 at 9:34
  • $\begingroup$ I can't think out other restriction for p1 and p2 $\endgroup$
    – Mengr
    Aug 28, 2022 at 9:43

2 Answers 2

Reset to default
4
$\begingroup$

Method -> "RandomSearch" seems work.

Clear[S1, S2, Sstr];
S1 = -(p1*Log[p1] + p2*Log[p2] + p3*Log[p3]);
S2 = -Log[p1^2 + p2^2 + p3^2];
Sstr = S1 - S2
NMaximize[{Sstr, 0 < {p1, p2, p3} < 1, p1 + p2 + p3 == 1}, {p1, p2, 
  p3}, Method -> "RandomSearch"]

enter image description here

The same as

Clear[S1, S2, diff, sol];
S1 = -(p1*Log[p1] + p2*Log[p2] + p3*Log[p3]);
S2 = -Log[p1^2 + p2^2 + p3^2];
diff = S1 - S2 /. p3 -> 1 - p1 - p2;
sol = NMaximize[{diff, 0 < {p1, p2} < 1, p1 + p2 < 1}, {p1, p2}, 
  Method -> "RandomSearch"]
Improve this answer
$\endgroup$
2
  • $\begingroup$ Great! How did you know that? $\endgroup$
    – Mengr
    Aug 28, 2022 at 9:44
  • $\begingroup$ @KarryMa Read the help document ,there are some Method in options. $\endgroup$
    – cvgmt
    Aug 28, 2022 at 9:56
1
$\begingroup$

First have a look at what is going on and then give good starting intervals for NMaximize.

Edited There are three equal maxima.

S[p1_, p2_, p3_] = (p1 + p2 + p3 == 1;
  S1 = -(p1*Log[p1] + p2*Log[p2] + p3*Log[p3]);
  S2 = -Log[(p1^2 + p2^2 + p3^2)];
  Sstr = S1 - S2)

Plot3D[S[p1, p2, 1 - p1 - p2], {p1, 0, 1}, {p2, 0, 1}, 
 PlotRange -> {0, 1/2}]

Reduce[S[p1, p2, 1 - p1 - p2] \[Element] Reals, p2, Reals]

(*   0 < p1 < 1 && 0 < p2 < 1 - p1   *)

nmax = NMaximize[{S[p1, p2, 1 - p1 - p2], 
   0 < p2 < 1 - p1}, {{p1, 0, .1}, {p2, 0, .1}}]

(*   {0.223655, {p1 -> 0.096693, p2 -> 0.096693}}   *)

nmax = NMaximize[{S[p1, p2, 1 - p1 - p2], 
   0 < p2 < 1 - p1}, {{p1, .8, 1}, {p2, 0, 1}}]

(*   {0.223655, {p1 -> 0.806614, p2 -> 0.0966931}}   *)

nmax = NMaximize[{S[p1, p2, 1 - p1 - p2], 
   0 < p2 < 1 - p1}, {{p1, 0, 1}, {p2, .8, 1}}]

(*   {0.223655, {p1 -> 0.096693, p2 -> 0.806614}}   *)
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ It seems that it is not the answer $\endgroup$
    – Mengr
    Aug 28, 2022 at 9:49
  • $\begingroup$ Corrected my answer. $\endgroup$
    – Akku14
    Aug 28, 2022 at 18:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.