Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Finding the optimum by repeteadly zooming on the solution space (or something like that)

0 views
Skip to first unread message

Mauricio Esteban Cuak

unread,
Oct 5, 2008, 11:48:21 PM10/5/08
to
Hello everyone.I know somebody has probably writ mathematica code on this
problem.
A general answer would probably benefit more people, but I'll do the
specific example, 'cause I'm not sure how to explain it in another way.

I have these restrictions:

cpoAg1= ( -x + (70*a*(x^0.4 + y^0.4)^0.75)/x^0.6);


(*and*)


cpoAg2= ((70*(1 - a)*(x^0.4 + y^0.4)^0.75)/y^0.6 - 2*y);


(* And I need to find the "a" that will maximise this following function. I
don't need and exact solution, but something that is sufficiently near *)


obj = -x^2/2 + 100*(x^0.4 + y^0.4)^1.75 - y^2;


(* "A" goes between 0 and 1 so I discretise to obtain the {x,y} that
maximise every "a"

the Table command gives me the list of rules which I can replace on "obj"
later to find the maximum. No problem here*)


rules = Table[
FindRoot[{cpoAg1 == 0, cpoAg2 == 0}, {{x, 0.1}, {y, 0.1}}],
{a, 0.1, 1, 0.1}
];


(*the maximum is found with this following function *)


Max[Thread[ReplaceAll[obj, rules]]];

So far so good...I could discretise "a" as thinly as I want, but I can't
afford the luxury of being that inneficient, 'cause I've got to do other
things later with this part of the program.

Want I want is to divide "a" into 0.1, 0.2, 0.3,....1. Say that 0.2 is the
optimum between this ten...Then i'll use the interval 1.1 to 2.9 and divide
it into ten parts and so on. I suppose you get the idea. Well, I don't
except you to do the work for me, but I've been having trouble programing
this and because it's such a common problem someone here may have already
written a code to manage this .

Thanks for your time!


cd


--
Por favor eviten enviarme archivos adjuntos de Word o Powerpoint (
http://www.gnu.org/philosophy/no-word-attachments.es.html )

Bill Rowe

unread,
Oct 6, 2008, 4:14:37 AM10/6/08
to
On 10/5/08 at 6:05 AM, cuak...@gmail.com (Mauricio Esteban Cuak)
wrote:

>Hello everyone.I know somebody has probably writ mathematica code on
>this problem. A general answer would probably benefit more people,
>but I'll do the specific example, 'cause I'm not sure how to explain
>it in another way.

>I have these restrictions:

>cpoAg1= ( -x + (70*a*(x^0.4 + y^0.4)^0.75)/x^0.6);

>(*and*)

>cpoAg2= ((70*(1 - a)*(x^0.4 + y^0.4)^0.75)/y^0.6 - 2*y);

>(* And I need to find the "a" that will maximise this following
>function. I don't need and exact solution, but something that is
>sufficiently near *)

>obj = -x^2/2 + 100*(x^0.4 + y^0.4)^1.75 - y^2;

>(* "A" goes between 0 and 1 so I discretise to obtain the {x,y} that
>maximise every "a"

>the Table command gives me the list of rules which I can replace on
>"obj" later to find the maximum. No problem here*)

>rules = Table[
>FindRoot[{cpoAg1 == 0, cpoAg2 == 0}, {{x, 0.1}, {y, 0.1}}], {a, 0.=
1,
>1, 0.1}
>];

>(*the maximum is found with this following function *)

>Max[Thread[ReplaceAll[obj, rules]]];

>So far so good...I could discretise "a" as thinly as I want, but I
>can't afford the luxury of being that inneficient, 'cause I've got
>to do other things later with this part of the program.

I don't understand why you would take this approach. Why not use
the built-in function NMaximize, That is:

In[20]:= NMaximize[{obj,
cpoAg1 == 0 && cpoAg2 == 0 && x > 0.1 && y > 0.1}, {a, x, y}]

Out[20]= {2084.72,{a->0.527688,x->22.6727,y->13.7173}}

Mauricio Esteban Cuak

unread,
Oct 7, 2008, 7:49:07 AM10/7/08
to
I appreciate both your help!
I was trying it the other way because I'm more interested in the speed of
the solution than in the precision. Ultimately, what I need to do is to find
the optimum "a" for at least thousands of values of r.
Say, for a couple of values:

Table[NMaximize[{obj, cpoAg1 == 0 && cpoAg2 == 0 && x > 0.1 && y > 0.1}, {a,

x, y}], {r, 0.4, 1, 0.2}]]


It seems that my approach doesn't improve the speed for most values of r, so
I'll try your suggestions.

If someone can suggest me a way of speeding things up, I'd really appreciate
it.


Kind Regards,


cd

2008/10/6 Bill Rowe <read...@sbcglobal.net>

Mark Westwood

unread,
Oct 9, 2008, 6:38:33 AM10/9/08
to
Hi Mauricio

I'd second Bill's suggestion -- use the inbuilt functions and
NMinimize is the obvious one for what you are trying to do.

As for speeding up the process, I make 2 observations:

a) You are unlikely, within Mathematica, to write a routine which
solves your equations more quickly than NMinimize, so long as you
stick to machine precision. If you do, let us know, I for one will be
seriously impressed.

b) Think carefully about what you are trying to optimise. Fast code
is good, but getting a fast solution to your problem is better -- it's
often the case with Mathematica that the time it takes to (slowly
compared with, say, Fortran on an MPP machine) compute is more than
offset by the rapid development time. For one-off code I wouldn't
even think about using Fortran unless I had good reason to think that
it would be O(100) times faster than Mathematica or that the total run
time would exceed about 2 days.

Regards

Mark Westwood

On Oct 7, 12:49 pm, "Mauricio Esteban Cuak" <cuak2...@gmail.com>
wrote:


> I appreciate both your help!
> I was trying it the other way because I'm more interested in the speed of

> the solution than in the precision. Ultimately, what I need to do is to f=


ind
> the optimum "a" for at least thousands of values of r.
> Say, for a couple of values:
>

> Table[NMaximize[{obj, cpoAg1 == 0 && cpoAg2 == 0 && x > 0.1 && y =


> 0.1}, {a,
>
> x, y}], {r, 0.4, 1, 0.2}]]
>

> It seems that my approach doesn't improve the speed for most values of r,=


so
> I'll try your suggestions.
>

> If someone can suggest me a way of speeding things up, I'd really appreci=


ate
> it.
>
> Kind Regards,
>
> cd
>

> 2008/10/6 Bill Rowe <readn...@sbcglobal.net>
>
>
>
> > On 10/5/08 at 6:05 AM, cuak2...@gmail.com (Mauricio Esteban Cuak)


> > wrote:
>
> > >Hello everyone.I know somebody has probably writ mathematica code on
> > >this problem. A general answer would probably benefit more people,
> > >but I'll do the specific example, 'cause I'm not sure how to explain
> > >it in another way.
>
> > >I have these restrictions:
>
> > >cpoAg1= ( -x + (70*a*(x^0.4 + y^0.4)^0.75)/x^0.6);
>
> > >(*and*)
>
> > >cpoAg2= ((70*(1 - a)*(x^0.4 + y^0.4)^0.75)/y^0.6 - 2*y);
>
> > >(* And I need to find the "a" that will maximise this following
> > >function. I don't need and exact solution, but something that is
> > >sufficiently near *)
>
> > >obj = -x^2/2 + 100*(x^0.4 + y^0.4)^1.75 - y^2;
>
> > >(* "A" goes between 0 and 1 so I discretise to obtain the {x,y} that
> > >maximise every "a"
>
> > >the Table command gives me the list of rules which I can replace on
> > >"obj" later to find the maximum. No problem here*)
>
> > >rules = Table[

> > >FindRoot[{cpoAg1 == 0, cpoAg2 == 0}, {{x, 0.1}, {y, 0.1}}], {a=


, 0.=
> > 1,
> > >1, 0.1}
> > >];
>
> > >(*the maximum is found with this following function *)
>
> > >Max[Thread[ReplaceAll[obj, rules]]];
>
> > >So far so good...I could discretise "a" as thinly as I want, but I
> > >can't afford the luxury of being that inneficient, 'cause I've got
> > >to do other things later with this part of the program.
>
> > I don't understand why you would take this approach. Why not use
> > the built-in function NMaximize, That is:
>
> > In[20]:= NMaximize[{obj,

> > cpoAg1 == 0 && cpoAg2 == 0 && x > 0.1 && y > 0.1}, {a, x, y=


}]
>
> > Out[20]= {2084.72,{a->0.527688,x->22.6727,y->13.7173}}
>
> --

> Por favor eviten enviarme archivos adjuntos de Word o Powerpoint (http://=
www.gnu.org/philosophy/no-word-attachments.es.html)


0 new messages