Re: Problem with NMinimize
- To: mathgroup at smc.vnet.net
- Subject: [mg119158] Re: Problem with NMinimize
- From: Ray Koopman <koopman at sfu.ca>
- Date: Mon, 23 May 2011 06:26:34 -0400 (EDT)
- References: <iraq2s$lno$1@smc.vnet.net>
On May 22, 3:55 am, dim <dimemp... at gmail.com> wrote:
> I try to minimize a function but it seems that Mathematica cannot calculate it.
> I would appreciate any help provided, because I have already lost 2 days trying to fix it, but I cannot find any solution... Mathematica either crashes or outputs the nnum error, even though I have defined the 'fob' function to work numerically.
>
> thist = RandomReal[100, 50000];
> t1 = RandomReal[100, 50000];
> t2 = RandomReal[100, 50000];
> t3 = RandomReal[100, 50000];
> t4 = RandomReal[100, 50000];
>
> fob[w1_?NumericQ, w2_?NumericQ, w3_?NumericQ, w4_?NumericQ,
> c_?NumericQ, pow_?NumericQ] :=
> (w1*(c + t1)^pow + w2*(c + t2)^pow + w3*(c + t3)^pow +
> w4*(c + t4)^pow)^(1/pow) - c;
>
> results = NMinimize[
> {Abs[1000*(Mean[thist] - Mean[fob[w1, w2, w3, w4, c, pow]])^2 +
> Total[(thist - fob[w1, w2, w3, w4, c, pow])^2]/Length[thist]],
> w1 + w2 + w3 + w4 == 1 && 0 < w1 < 1 && 0 < w2 < 1,
> 0 < w3 < 1 && 0 < w4 < 1 && 0 < c, 0 < pow}, {w1, w2, w3, w4, c,
> pow}]
Here's a toy example, in which the constraints are implied by
minimizing with respect to a multivariate logit of {w1,w2,w3,w4}
and the logs of c and pow.
There are four versions, in a 2 x 2 design:
inline vs external function evaluate, and with vs without Abs.
The following results are typical. In particular,
if the function is external then Abs never matters.
thist = RandomReal[100, n = 50];
tvecs = RandomReal[100, {4,n}];
Clear[fab];
fab[v1_?NumericQ, v2_?NumericQ, v3_?NumericQ,
d_?NumericQ, q_?NumericQ] :=
With[{w = #/Tr@#& @ Exp@{v1,v2,v3,0}, c = E^d, pow = E^q},
Abs[1000*Mean[#]^2 + #.#/Length@thist]&[
thist+c-(w.(tvecs+c)^pow)^(1/pow)]]
Clear[fub];
fub[v1_?NumericQ, v2_?NumericQ, v3_?NumericQ,
d_?NumericQ, q_?NumericQ] :=
With[{w = #/Tr@#& @ Exp@{v1,v2,v3,0}, c = E^d, pow = E^q},
(1000*Mean[#]^2 + #.#/Length@thist)&[
thist+c-(w.(tvecs+c)^pow)^(1/pow)]]
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
Clear[v1,v2,v3,d,q]; NMinimize[ (* inline, Abs *)
With[{w = #/Tr@#& @ Exp[{v1,v2,v3,0}], c = E^d, pow = E^q},
Abs[1000*Mean[#]^2 + #.#/Length@thist]&[
thist+c-(w.(c+tvecs)^pow)^(1/pow)]], {v1,v2,v3,d,q}]
{w,c,pow} = {#/Tr@#& @ Exp[{v1,v2,v3,0}], E^d, E^q }/.%[[2]]
{996.361, {d -> 3.27105, q -> -8.40467,
v1 -> 0.229813, v2 -> 0.318666, v3 -> 0.691812}}
{{0.223471, 0.244236, 0.354704, 0.177589}, 26.3391, 0.00022382}
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
Clear[v1,v2,v3,d,q]; NMinimize[ (* inline, no Abs *)
With[{w = #/Tr@#& @ Exp[{v1,v2,v3,0}], c = E^d, pow = E^q},
1000*Mean[#]^2 + #.#/Length@thist&[
thist+c-(w.(c+tvecs)^pow)^(1/pow)]], {v1,v2,v3,d,q}]
{w,c,pow} = {#/Tr@#& @ Exp[{v1,v2,v3,0}], E^d, E^q }/.%[[2]]
{996.358, {d -> 3.27172, q -> -17.1079,
v1 -> 0.229632, v2 -> 0.318307, v3 -> 0.691469}}
{{0.223487, 0.24421, 0.354671, 0.177633}, 26.3567, 3.71652*^-8}
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
Clear[v1,v2,v3,d,q]; NMinimize[ (* external, Abs *)
fab[v1,v2,v3,d,q], {v1,v2,v3,d,q}]
{w,c,pow} = {#/Tr@#& @ Exp[{v1,v2,v3,0}], E^d, E^q }/.%[[2]]
{996.363, {d -> 3.27058, q -> -7.89698,
v1 -> 0.23018, v2 -> 0.318626, v3 -> 0.691966}}
{{0.223525, 0.244196, 0.354713, 0.177566}, 26.3266, 0.000371864}
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
Clear[v1,v2,v3,d,q]; NMinimize[ (* external, no Abs *)
fub[v1,v2,v3,d,q], {v1,v2,v3,d,q}]
{w,c,pow} = {#/Tr@#& @ Exp[{v1,v2,v3,0}], E^d, E^q }/.%[[2]]
{996.363, {d -> 3.27058, q -> -7.89698,
v1 -> 0.23018, v2 -> 0.318626, v3 -> 0.691966}}
{{0.223525, 0.244196, 0.354713, 0.177566}, 26.3266, 0.000371864}