Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: NMinimize a function of NMaximize

  • To: mathgroup at smc.vnet.net
  • Subject: [mg79993] Re: [mg79947] NMinimize a function of NMaximize
  • From: Saptarshi Guha <sapsi at pobox.com>
  • Date: Fri, 10 Aug 2007 01:50:11 -0400 (EDT)
  • References: <200708090924.FAA21421@smc.vnet.net> <46BB6D46.4040901@wolfram.com>

Hello,

On Aug 9, 2007, at 3:38 PM, Daniel Lichtblau wrote:

> sapsi wrote:
>> I have a function
>> g[x_]:=1 (Pi - 2 x*Sqrt[1 - x^2] - 2 ArcSin[x])
>> d[x_, o_, n_] := Abs[g[x] - Normal[Series[g[y], {y, o, n}]]] /. y - 
>> > x
>> d[] is the absolute difference of g[] and its Taylor series
>> approximation
>> dm[p_] := NMaximize[{d[x, p, 3], 0 <= x <= 1}, x][[1]]
>> dm[] is the maximum absolute difference between the Taylor series
>> approximation(3rd order) around p and g[].
>> I wish to find that value of 'p' that minimizes this maximum
>> difference - i tried plotting and can see where the minima occurs but
>> would like the exact value. So, it thought this would work
>> NMinimize[{NMaximize[{ d[x, p, 3], 0 <= x <= 1}, x], 0 <= p <= 1},  
>> p].
>> Instead i get errors (briefly)
>> NMaximize::nnum: The function value -Abs[-2.41057-(2 (<<19>>-p)^2 \
>> p)/Sqrt[1-p^2]+2 p Sqrt[1-p^2]+(2 (<<1>>)^3)/(3 Sqrt[1-<<1>>] \
>> (-1+p^2))-(4 (0.652468-p) (-1+p^2))/Sqrt[1-p^2]+2 ArcSin[p]] is not a
>> \
>> number at {x} = {0.652468}. >>
>> NMaximize::nnum: "The function value \
>> -Abs[-2.41057-(2\(<<19>>-p)^2\p)/Sqrt[1-p^2]+2\ p\ Sqrt[1-p^2]+(2\ 
>> (<<\
>> 1>>)^3)/(3\Sqrt[1-<<1>>]\(-1+p^2))-(4\(0.652468-p)\(-1+p^2))/Sqrt 
>> [1-p^
>> \
>> 2]+2\ ArcSin[p]] is not a number at {x} = {0.6524678079740285`}."
>> NMaximize::nnum: The function value -Abs[-2.41057-(2 (<<19>>-p)^2 \
>> p)/Sqrt[1-p^2]+2 p Sqrt[1-p^2]+(2 (<<1>>)^3)/(3 Sqrt[1-<<1>>] \
>> (-1+p^2))-(4 (0.652468-p) (-1+p^2))/Sqrt[1-p^2]+2 ArcSin[p]] is not a
>> \
>> number at {x} = {0.652468}. >>
>> NMinimize::nnum:
>> Can anyone provide any pointers on how to find the minimum of dm[]?
>> Thank you for your time
>> Saptarshi
>
> Getting the code to handle the two-level optimization is relatively  
> easy. You could do, for example:
>
> g[x_] :=  (Pi - 2*x*Sqrt[1 - x^2] - 2*ArcSin[x])
> d[x_, o_, n_] := Abs[g[x] - Normal[Series[g[y], {y,o,n}]]] /. y->x
>
> maxp[x_,p_Real,n_] := First[NMaximize[{d[x,p,3], 0<=x<=1}, x,
>   Method->DifferentialEvolution]]
>
> Timing[{min,pbest} = NMinimize[{maxp[x,p,3], 0<=p<=1}, p]]
>
> Problem is it will be quite slow, and moreover not give a reliable  
> result. The reason for the latter deficiency is that the inner  
> optimization will often go to the "wrong" side of the x interval,  
> and not find the correct max.
>
> A simple way around this is to realize (by computations, if you  
> like, which is what I did) that for given p the max is always at  
> one of the endpoints, either x=0 or x=1. So you can save both time  
> and mistakes by checking those directly.
>
> I recast so that some computations do not get repeated. In  
> particular I'll start with the generic Taylor series.
>
> d[x_, o_] = Abs[2*o*Sqrt[1 - o^2] -
>   (4*(-1 + o^2)*(-o + x))/Sqrt[1 - o^2] -
>   (2*o*(-o + x)^2)/Sqrt[1 - o^2] + (2*(-o + x)^3)/
>    (3*Sqrt[1 - o^2]*(-1 + o^2)) - 2*x*Sqrt[1 - x^2] +
>     2*ArcSin[o] - 2*ArcSin[x]]

I used this, but it appears to have problems at o=1, so  I kept the  
limits away from 1.

>
> maxp[p_Real] := Max[d[0,p],d[1,p]]
>
> In[13]:= Timing[{min,pbest} = NMinimize[{maxp[p], 0<=p<=1}, p]]
> Out[13]= {1.6321, {0.0635301, {p -> 0.593819}}}
>
> If you check d[...,p] at this p value you will find that the values  
> are equal at endpoints x = {0,1}. So we find the min p just where  
> the endpoints balance.


I proceeded in a slightly visual fashion,
> d[x_, o_] = Abs[2*o*Sqrt[1 - o^2] -
>   (4*(-1 + o^2)*(-o + x))/Sqrt[1 - o^2] -
>   (2*o*(-o + x)^2)/Sqrt[1 - o^2] + (2*(-o + x)^3)/
>    (3*Sqrt[1 - o^2]*(-1 + o^2)) - 2*x*Sqrt[1 - x^2] +
>     2*ArcSin[o] - 2*ArcSin[x]]

dm[p_] := First[NMaximize[{d[z, p], 0 <= z <= 1}, z]]

f = Table[dm[p], {p, 0, 0.99999, 0.02}]
ListLinePlot[f,Filling->Axis]

The figure is a plot of the Maxima vs p, I then keep on zooming to  
try and locate the location of the minimum maxima. After some trials  
i get p=0.6428021.

NMaximize[{d[z, 0.6428021], 0 < z < 1}, z] returns {0.0523013, {z ->  
1.}}

however,
NMaximize[{d[z, 0.593819], 0 < z < 1}, z] returns {0.06353, {z -> 1.}}

So it appears, using the Max function (even though the argument for  
it is sound) does not lead to the Minima.
Any thoughts?Have i made a mistake?

Thank you for your time
Saptarshi


>
> By the way, this is distantly related to a bilevel optimization  
> used for Trefethen's 2002 SIAM challenge problem #5. There is a zip  
> file at
>
> http://library.wolfram.com/infocenter/Conferences/5353/
>
> It contains a Mathematica notebook with code to handle that  
> optimization.
>
>
> Daniel Lichtblau
> Wolfram Research

Saptarshi Guha | sapsi at pobox.com | http://www.stat.purdue.edu/~sguha
"I have not the slightest confidence in 'spiritual manifestations.'"
-- Robert G. Ingersoll



  • Prev by Date: Re: Two different packages can not Need[] the same utility
  • Next by Date: RE: Inverse Tangent function
  • Previous by thread: Re: NMinimize a function of NMaximize
  • Next by thread: Re: NMinimize a function of NMaximize