Griewank Function

Author

Eric W. Weisstein
December 20, 2010

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Optimization/GriewankFunction.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/GriewankFunction.html.

©2010 Wolfram Research, Inc. except for portions noted otherwise

f[n_,x_Symbol]:=Module[{v=Array[x,n]},(1/4000)v.v-Times@@MapIndexed[Cos[((#1)/(Sqrt[#2[[1]]]))]&,v]+1]

f[n_,v_List]:=Module[{},(1/4000)v.v-Times@@MapIndexed[Cos[((#1)/(Sqrt[#2[[1]]]))]&,v]+1]

Table[f[n,x],{n,3}]

f[1,x]

Plot[f[1,x],{x[1],-600,600},AxesLabel->{x,Subscript[f,1][x]}]

Point[{#,f[1,{#}]}&/@N[min]]

Plot[f[1,{x}],{x,-600,600},Epilog->{Red,Point[{#,f[1,{#}]}&/@N[min]]}]

Plot3D[f[2,x],{x[1],-600,600},{x[2],-600,600},MaxRecursion->10]

Maxima

n==1

f[1,x]/.x[1]:>x

g[x_]:=1+((x^2)/4000)-Cos[x]

Smallest Positive Minimum

x1=Reduce[g'[x]==0&&g''[x]>0&&0<x<=10,x,Reals][[2]]

N[x1,21]

RealDigits[x1,10,200]

RealDigits[Root[{2000 Sin[#1]+#1&,6.28`3}],10,200][[1]]

5

Length[Reduce[g'[x]==0&&g''[x]>0&&-14<=x<=14,x,Reals]]

9

Length[Reduce[g'[x]==0&&g''[x]>0&&-28<=x<=28,x,Reals]]

1, ..., 30

Length[Reduce[g'[x]==0&&g''[x]>0&&0<x≤20,x,Reals][[All,2]]]

Table[Length[x/.{ToRules[Reduce[g'[x]==0&&g''[x]>0&&-n<x<=n,x,Reals]]}],{n,50}]//Timing

N[min=x/.{ToRules[Reduce[g'[x]==0&&g''[x]>0&&0<x<600,x,Reals]]}]

(l=Table[Count[min,_?(#≤n&)],{n,0,200}])//Timing

2l+1

min[[1]]//FullSimplify

N[%,100]

Plot[f[1,{x}],{x,0,100},Epilog->{Red,PointSize[.02],Point[{#,f[1,{#}]}&/@N[min]]}]

600

N[min=x/.{ToRules[Reduce[g'[x]==0&&g''[x]>0&&0<x<600,x,Reals]]}]

Length[%]

N[min=x/.{ToRules[Reduce[g'[x]==0&&g''[x]>0&&-600<=x<=600,x,Reals]]}]

Length[%]

n==2

-------- Original Message --------
Subject: Re: minima of 2-D Griewank function
Date: Sun, 26 Dec 2010 18:23:18 -0600
From: Adam Strzebonski

Eric Weisstein wrote:
> Hi, Adam.
> 
> Any hope of getting these, at least for small n?

Not with the current methods. There are no methods for symbolic solving of such equations. For a bounded domain an interval arithmetic search could work, but we don’t have it implemented for multivariate problems.

Adam

f[2,x]/.{x[1]:>x,x[2]->y}//FullSimplify

h[x_,y_]:=1+(((x^2)+(y^2))/4000)-Cos[x] Cos[(y/(Sqrt[2]))]

FullSimplify[Derivative[1,0][h][x,y]==0&&Derivative[0,1][h][x,y]==0&&Derivative[2,0][h][x,y]>0&&Derivative[0,2][h][x,y]>0]

Length[min=x/.{ToRules[Reduce[
x+2000 Cos[(y/(Sqrt[2]))] Sin[x]==0&&y+1000 (Sqrt[2]) Cos[x] Sin[(y/(Sqrt[2]))]==0&&1+2000 Cos[x] Cos[(y/(Sqrt[2]))]>0&&0<x<600&&0<y<600,{x,y},Reals]]}]//Timing

Length[%]

Table[Reduce[
x+2000 Cos[(y/(Sqrt[2]))] Sin[x]==0&&y+1000 (Sqrt[2]) Cos[x] Sin[(y/(Sqrt[2]))]==0&&1+2000 Cos[x] Cos[(y/(Sqrt[2]))]>0&&-n<=x≤n&&-n<=y<=n,{x,y},Reals]//Timing,{n,1}]

(([-14,14])^n)

5, 31, 157

(([-28,28])^n)

9, 111, 1215