0
$\begingroup$

Updated I Edited my code with the help of answer of Okkes Dulgerci as

ClearAll["Global`*"]
SeedRandom[];
ClearSystemCache[]
f1[a_, b_, g_] = 
  ProbabilityDistribution[
   3 a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 
     1) (1 - (1 + g x^(-b))^(-a/g))^2, {x, 0, \[Infinity]}];
f2[a_, b_, g_] = 
  ProbabilityDistribution[
   2 a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 
     1) (1 - (1 + g x^(-b))^(-a/g)), {x, 0, \[Infinity]}];
f3[a_, b_, g_] = 
  ProbabilityDistribution[
   a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 1) , {x, 0, \[Infinity]}];
t1 = RandomVariate[f1[3, 3, 2], {50, 25}];
t2 = RandomVariate[f2[3, 3, 4], {50, 25}];
t3 = RandomVariate[f3[3, 3, 6], {50, 25}];
lnL[g1_?NumberQ, g2_?NumberQ, g3_?NumberQ, a_?NumberQ, b_?NumberQ] := 
  Module[{n = 25, k = 3},
   n Log[Factorial[k]] + n k Log[a] + n k Log[b] - (b + 1) ( \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
          1\), \(n\)]\((Log[\((t1[[j, i]])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
          1\), \(n\)]\((Log[\((t2[[j, i]])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
          1\), \(n\)]\((Log[\((t3[[j, i]])\)])\)\)) - (\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(a\), \(g1\)] + 1)\) Log[\((1 + g1\ 
\*SuperscriptBox[\((t1[[j, i]])\), \(-b\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(a\), \(g2\)] + 1)\) Log[\((1 + g2\ 
\*SuperscriptBox[\((t2[[j, i]])\), \(-b\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(a\), \(g3\)] + 1)\)\ Log[\((1 + g3\ \*
SuperscriptBox[
RowBox[{"(", 
RowBox[{"t3", "[[", 
RowBox[{"j", ",", "i"}], "]]"}], ")"}], 
StyleBox[
RowBox[{"-", "b"}],
FontWeight->"Plain"]])\)])\)\))
    + ( \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((\((k - 1)\)\ Log[\((1 - 
\*SuperscriptBox[\((1 + g1\ 
\*SuperscriptBox[\((t1[[j, i]])\), \(-b\)])\), 
FractionBox[\(-a\), \(g1\)]])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((\((k - 2)\) Log[\((1 - 
\*SuperscriptBox[\((1 + g2\ 
\*SuperscriptBox[\((t2[[j, i]])\), \(-b\)])\), 
FractionBox[\(-a\), \(g2\)]])\)])\)\))];
Table[FindMaximum[
  lnL[g1, g2, g3, a, 
   b], {{g1, 2}, {g2, 4}, {g3, 6}, {a, 3}, {b, 3}}], {j, 1, 50}]

Now this code works well. But

1) It gives some time initial values as an estimates (I think when not convergent). Can we block them?

2) Whole process repeat 50 times (using table command), is correct?.

$\endgroup$
  • $\begingroup$ What are data1, data2, data3? $\endgroup$ – OkkesDulgerci Mar 10 '18 at 20:40
  • $\begingroup$ Data1, data2, and data3 are random varieties of custom distribution define above as f1,f2 and f3. $\endgroup$ – SAAN Mar 11 '18 at 0:57
  • $\begingroup$ n = Length[t1]=5 why do you generate $5\times25$ data if don't use them all? $\endgroup$ – OkkesDulgerci Mar 11 '18 at 4:30
  • $\begingroup$ Your distributions look awfully like BetaPrimeDistribution[]. $\endgroup$ – J. M. will be back soon Mar 11 '18 at 6:03
  • $\begingroup$ @OkkesDulgerci Actually I have to estimate the parameters 10000 time. Yes here I have to used n=25, 5 is incorrect. $\endgroup$ – SAAN Mar 11 '18 at 14:43
1
$\begingroup$

I have tried to simplified your code. You don't need to maximize Log-likelihood, in Mathematica you can maximize likelihood. Please double check your likelihood. For this set up it does not work.

ClearAll["Global`*"]

f1[a_, b_, g_] =   
  ProbabilityDistribution[  
   3 a b x^(-b - 1) (1 + g x^(-b))^(-a/g -  
       1) (1 - (1 + g x^(-b))^(-a/g))^2, {x, 0, \[Infinity]}];

f2[a_, b_, g_] =   
  ProbabilityDistribution[ 
   2 a b x^(-b - 1) (1 + g x^(-b))^(-a/g -  
       1) (1 - (1 + g x^(-b))^(-a/g)), {x, 0, \[Infinity]}];

f3[a_, b_, g_] =   
  ProbabilityDistribution[
   a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 1) , {x, 0, \[Infinity]}];

data1 = RandomVariate[f1[1.5, 2, 0.2], {5, 25}];
data2 = RandomVariate[f2[1.5, 2, 0.4], {5, 25}];
data3 = RandomVariate[f3[1.5, 2, 0.6], {5, 25}];

lnL[g1_?NumberQ, g2_?NumberQ, g3_?NumberQ, a_?NumberQ, b_?NumberQ] := 
 Module[{n = Length[data1], k = 3},
     n Log[Factorial[k]] + n k Log[a] + n k Log[b] - (b + 1) ( \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((Log[\((data1[\([i]\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((Log[\((data2[\([i]\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((Log[\((data3[\([i]\)])\)])\)\)) - (\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(-a\), \(g1\)] + 1)\) Log[\((1 + g1\ 
\*SuperscriptBox[\((data1[\([i]\)])\), \(-b\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(-a\), \(g2\)] + 1)\) Log[\((1 + g2\ 
\*SuperscriptBox[\((data2[\([i]\)])\), \(-b\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(-a\), \(g3\)] + 1)\)\ Log[\((1 + g3\ \*
SuperscriptBox[
RowBox[{"(", 
RowBox[{"data3", "[", 
RowBox[{"[", "i", "]"}], "]"}], ")"}], 
StyleBox[
RowBox[{"-", "b"}],
FontWeight->"Plain"]])\)])\)\))
       + ( \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
        1\), \(n\)]\((\((k - 1)\)\ Log[\((1 - 
\*SuperscriptBox[\((1 + g1\ 
\*SuperscriptBox[\((data1[\([i]\)])\), \(-b\)])\), 
FractionBox[\(-a\), \(g1\)]])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
        1\), \(n\)]\((\((k - 2)\) Log[\((1 - 
\*SuperscriptBox[\((1 + g1\ 
\*SuperscriptBox[\((data2[\([i]\)])\), \(-b\)])\), 
FractionBox[\(-a\), \(g2\)]])\)])\)\))]



NMaximize[ First@lnL[g1, g2, g3, a, b], {g1, g2, g3, a, b}, 
 Method -> "DifferentialEvolution", MaxIterations -> 10000]

Edit This works. I am not sure all parameters are positive!! Replace 2 by 10000 in Table

Table[f1[a_, b_, g_] = 
    ProbabilityDistribution[
      3 a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 
            1) (1 - (1 + g x^(-b))^(-a/g))^2, {x, 0, \[Infinity]}];
 f2[a_, b_, g_] = 
    ProbabilityDistribution[
      2 a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 
            1) (1 - (1 + g x^(-b))^(-a/g)), {x, 0, \[Infinity]}];
 f3[a_, b_, g_] = 
    ProbabilityDistribution[
      a b x^(-b - 1) (1 + g x^(-b))^(-a/g - 1) , {x, 0, \[Infinity]}];
 t1 = RandomVariate[f1[3, 3, 2], 25];
 t2 = RandomVariate[f2[3, 3, 4], 25];
 t3 = RandomVariate[f3[3, 3, 6], 25];
 lnL[g1_?NumberQ, g2_?NumberQ, g3_?NumberQ, a_?NumberQ, b_?NumberQ] := 
    Module[{n = 25, k = 3},
      n Log[Factorial[k]] + n k Log[a] + n k Log[b] - (b + 1) ( \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
          1\), \(n\)]\((Log[\((t1[\([i]\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
          1\), \(n\)]\((Log[\((t2[\([i]\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
          1\), \(n\)]\((Log[\((t3[\([i]\)])\)])\)\)) - (\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(a\), \(g1\)] + 1)\) Log[\((1 + g1\ 
\*SuperscriptBox[\((t1[\([i]\)])\), \(-b\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(a\), \(g2\)] + 1)\) Log[\((1 + g2\ 
\*SuperscriptBox[\((t2[\([i]\)])\), \(-b\)])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\((\((
\*FractionBox[\(a\), \(g3\)] + 1)\)\ Log[\((1 + g3\ \*
SuperscriptBox[
RowBox[{"(", 
RowBox[{"t3", "[", 
RowBox[{"[", "i", "]"}], "]"}], ")"}], 
StyleBox[
RowBox[{"-", "b"}],
FontWeight->"Plain"]])\)])\)\))
        + ( \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((\((k - 1)\)\ Log[\((1 - 
\*SuperscriptBox[\((1 + g1\ 
\*SuperscriptBox[\((t1[\([i]\)])\), \(-b\)])\), 
FractionBox[\(-a\), \(g1\)]])\)])\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 
         1\), \(n\)]\((\((k - 2)\) Log[\((1 - 
\*SuperscriptBox[\((1 + g2\ 
\*SuperscriptBox[\((t2[\([i]\)])\), \(-b\)])\), 
FractionBox[\(-a\), \(g2\)]])\)])\)\))];
 NMaximize[ {lnL[g1, g2, g3, a, b], g1 > 0, g2 > 0, g3 > 0, a > 0, 
   b > 0}, {g1, g2, g3, a, b}], 2]

{{-85.6331, {g1 -> 2.64838, g2 -> 3.23484, g3 -> 8.12382, a -> 3.38133, b -> 2.34444}}, {-63.0394, {g1 -> 2.14105, g2 -> 4.01569, g3 -> 9.34059, a -> 3.05859, b -> 3.05695}}}

$\endgroup$
  • $\begingroup$ ...well, the point of optimizing log-likelihood is that it's less likely to overflow or underflow while searching parameter space with it. $\endgroup$ – J. M. will be back soon Mar 11 '18 at 4:48
  • $\begingroup$ I know that. We are not sure if OP took log of likelihood correctly. $\endgroup$ – OkkesDulgerci Mar 11 '18 at 4:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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