Optimization

Code for Chapter Opening Art

fQuad[x_]:=4 x (1-x);
der[x_]:=Evaluate[fQuad'[x]]
fIter[x_,n_]:=Nest[fQuad,x,n];
fTraj[x_,n_]:=NestList[fQuad,x,n];
sensList[x_,n_]:=Most[FoldList[Times,{1},der[fTraj[x,n]]]];
noisy=SetPrecision[fTraj[0.1,100],100];

Shadow[noisy_List, n_Integer, start_] := (
residual[x0_?NumericQ] :=Block[{$MinPrecision = n,$MaxPrecision = n},
fTraj[x0,n]-Take[noisy,n+1]];
FindMinimum[0,{x0,SetPrecision[start, n]}, 
Method->{"LevenbergMarquardt","Residual"->residual[x0],"Jacobian"->sensList[N[x0,n],n]},
 WorkingPrecision->n,PrecisionGoal->16,AccuracyGoal->16])

Do[sol=Shadow[noisy,nn,If[nn==50,1/10,x0/.sol[[2]]]],{nn,50,100,50}];
shadowSeed100=x0/.sol[[2]]

p=27;npts=32000;
shadowSeed100=0.0999999999999999888431484532050331385533967792120140701562365688647112149388903507268565690921345049188546113663541;
residual1[x0_?NumericQ,n_]:=fTraj[x0,n]-Take[noisy,n+1];
data=Table[Max[Abs[residual1[N[x0,100],100]]],{x0,shadowSeed100-(10^(-p)),shadowSeed100+(10^(-p)),2 (10^(-p))/npts}];
N[1/10-shadowSeed100]

ListPlot[data,Frame->True,PlotStyle->{Black,PointSize[0.003]},Axes->False,PlotRange->{-0.1,1.1},FrameTicks->{{{(npts/2),"shadow value\napprox. (1/10) - \!(10^(-17))"},{0,StringForm["shadow value - (10^(-``))",p]},{npts,StringForm["shadow value + (10^(-``))",p]}},{0,0.5,1},None,None},Prolog->{{EdgeForm[Thickness[0.003]],FaceForm[GrayLevel[0.85]],Disk[{(npts/2),Max[Abs[residual1[shadowSeed100,100]]]},{ (npts/2),1}/30]}}]

ListLinePlot[data,Frame->True,PlotStyle->{Black},Axes->False,PlotRange->{-0.1,1},FrameTicks->{{{(npts/2),"shadow value\napprox. (1/10) - \!(10^(-17))"},{0,StringForm["shadow value - (10^(-``))",p]},{npts,StringForm["shadow value + (10^(-``))",p]}},{0,0.5,1},None,None},Prolog->{{EdgeForm[Thickness[0.003]],FaceForm[GrayLevel[0.85]],Disk[{(npts/2),Max[Abs[residual1[shadowSeed100,100]]]},{ (npts/2),1}/30]}}]

.  FindMinimum

f[x_]:=((x^2)/100)-Sin[3 x] Cos[4 x+Log[(x^2)+1]]+(E^(-(x/3)));
Plot[f[x],{x,0,20}, Frame->True, Axes->False, PlotStyle->Thick, PlotPoints->100]

FindMinimum[f[x],{x,15}]

FindMinimum[f[x],{x,3}]

FindMinimum[f[x],{x,0,20}]

seeds=Range[0,20,.2];
mins=Union[Table[x/.Last[FindMinimum[f[x],{x,s}]],{s,seeds}]];//Timing//Quiet

Show[Plot[f[x], {x,0,20}, PlotPoints->100, PlotStyle->Thick], Graphics[{Red,PointSize[0.02],Point[{#, f[#]}]& /@ mins}],Frame->True, Axes->False]

NMinimize[f[x],{x,0,20}]

NMinimize[f[x],{x,0,20},Method->"RandomSearch"]

p=Plot[f[x],{x,0,20},PlotPoints->100];

plotPts=Flatten[Cases[p,Line[z_]:>z,∞],1];
seed=First[SortBy[plotPts,Last]]
Quiet[FindMinimum[f[x],{x,seed[[1]]}]]

data=Table[{x,N[10 (E^(Sin[x]))+2 (x^2)+0.1 (x+Cos[x])]},{x,1,10}];

model[a_,b_][x_]:=a (E^(Sin[x]))+b (x^2)
residual[a_,b_]:=Total[Table[(((d[[2]]-model[a,b][d[[1]]]))^2),{d,data}]]

residual[1,2]

FindMinimum[residual[a,b], {a, 3}, {b,3}]

Clear[a,b]

FindFit[data, a (E^(Sin[x]))+b (x^2), {a,b}, x]

.  Algebraic Optimization

FullSimplify[Maximize[Sin[x]+Cos[x],x]]

Maximize[Sin[2 x]+Cos[x],x]

Maximize[Sin[2 x]+Cos[ x], x]//ToRadicals

Maximize[{a b+b c+c d+d a+a c+b d-4 a b c d,a>0,b>0,c>0,d>0,(a^2)+(b^2)+(c^2)+(d^2)≤1},{a,b,c,d}]

.  Linear Programming and Its Cousins

vbles=Flatten[Join[Table[(Subscript[x, i,j]),{i,4},{j,3}],Table[(Subscript[y, i]),{i,4}]]];

objective=Simplify[5.83 (Subscript[y, 1])+3.7 (Subscript[y, 2])+2.6 (Subscript[y, 3])+0.2 (Subscript[y, 4])-31.02 ((Subscript[x, 1,1])+(Subscript[x, 1,2])+(Subscript[x, 1,3]))-33.15 ((Subscript[x, 2,1])+(Subscript[x, 2,2])+(Subscript[x, 2,3]))-36.35 ((Subscript[x, 3,1])+(Subscript[x, 3,2])+(Subscript[x, 3,3]))+45.15 ((Subscript[x, 1,1])+(Subscript[x, 2,1])+(Subscript[x, 3,1])+(Subscript[x, 4,1]))+42.95 ((Subscript[x, 1,2])+(Subscript[x, 2,2])+(Subscript[x, 3,2])+(Subscript[x, 4,2]))+40.99 ((Subscript[x, 1,3])+(Subscript[x, 2,3])+(Subscript[x, 3,3])+(Subscript[x, 4,3]))-38.75 ((Subscript[x, 4,1])+(Subscript[x, 4,2])+(Subscript[x, 4,3]))];
constraint={4 (Subscript[x, 4,1])≥27 (Subscript[x, 1,1])+9 (Subscript[x, 2,1])+4 (Subscript[x, 3,1]),(Subscript[x, 3,2])+9 (Subscript[x, 4,2])≥22 (Subscript[x, 1,2])+4 (Subscript[x, 2,2]),(Subscript[x, 2,3])+6 (Subscript[x, 3,3])+14 (Subscript[x, 4,3])≥17 (Subscript[x, 1,3]),(Subscript[y, 1])+(Subscript[x, 1,1])+(Subscript[x, 1,2])+(Subscript[x, 1,3])==4000,(Subscript[y, 2])+(Subscript[x, 2,1])+(Subscript[x, 2,2])+(Subscript[x, 2,3])==5050,(Subscript[y, 3])+(Subscript[x, 3,1])+(Subscript[x, 3,2])+(Subscript[x, 3,3])==7100,(Subscript[y, 4])+(Subscript[x, 4,1])+(Subscript[x, 4,2])+(Subscript[x, 4,3])==4300,(Subscript[x, 1,1])+(Subscript[x, 2,1])+(Subscript[x, 3,1])+(Subscript[x, 4,1])≤10000,(Subscript[x, 1,3])+(Subscript[x, 2,3])+(Subscript[x, 3,3])+(Subscript[x, 4,3])≥15000,(Subscript[x, 1,1])≥0,(Subscript[x, 1,2])≥0,(Subscript[x, 1,3])≥0,(Subscript[x, 2,1])≥0,(Subscript[x, 2,2])≥0,(Subscript[x, 2,3])≥0,(Subscript[x, 3,1])≥0,(Subscript[x, 3,2])≥0,(Subscript[x, 3,3])≥0,(Subscript[x, 4,1])≥0,(Subscript[x, 4,2])≥0,(Subscript[x, 4,3])≥0,(Subscript[y, 1])≥0,(Subscript[y, 2])≥0,(Subscript[y, 3])≥0,(Subscript[y, 4])≥0};

(sol1=Maximize[{objective,constraint},vbles])//Timing

objective=Rationalize[objective]

sol2=Maximize[{objective,constraint},vbles]

Max[(vbles/.sol1[[2]])-(vbles/.sol2[[2]])]

Streamlining the LP problem

X= Map[x,Range[16]]
fix=Thread[vbles -> X]

constraint={4 (Subscript[x, 4,1])-27 (Subscript[x, 1,1])-9 (Subscript[x, 2,1])-4 (Subscript[x, 3,1])≥0,(Subscript[x, 3,2])+9 (Subscript[x, 4,2])-22 (Subscript[x, 1,2])-4 (Subscript[x, 2,2])≥0,(Subscript[x, 2,3])+6 (Subscript[x, 3,3])+14 (Subscript[x, 4,3])-17 (Subscript[x, 1,3])≥0,(Subscript[y, 1])+(Subscript[x, 1,1])+(Subscript[x, 1,2])+(Subscript[x, 1,3])==4000,(Subscript[y, 2])+(Subscript[x, 2,1])+(Subscript[x, 2,2])+(Subscript[x, 2,3])==5050,(Subscript[y, 3])+(Subscript[x, 3,1])+(Subscript[x, 3,2])+(Subscript[x, 3,3])==7100,(Subscript[y, 4])+(Subscript[x, 4,1])+(Subscript[x, 4,2])+(Subscript[x, 4,3])==4300,(Subscript[x, 1,1])+(Subscript[x, 2,1])+(Subscript[x, 3,1])+(Subscript[x, 4,1])≤10000,(Subscript[x, 1,3])+(Subscript[x, 2,3])+(Subscript[x, 3,3])+(Subscript[x, 4,3])≥15000};

newconstraint = constraint/. fix
newobj = objective/. fix

Cvec=Table[Coefficient[newobj,x[i]],{i,16}]

new1=newconstraint/.z_==b_:>{z≥b,z≤b}

new2=Flatten[new1/.z_≤b_:>-z≥-b]

{B,M}={-1,1} Normal[CoefficientArrays[new2/.GreaterEqual->Equal,X]];
B
M//MatrixForm

(sol=LinearProgramming[-Cvec,M,B])//Timing
Cvec.sol

The Marriage Problem

Needs["Combinatorica`"]

SeedRandom[1];n=5;
(mPref=Table[RandomPermutation[n],{n}])
(fPref=Table[RandomPermutation[n],{n}])

mScore=mPref;fScore=fPref;
Do[mScore[[i]]=n+1-InversePermutation[mPref[[i]]],{i,n}]
Do[fScore[[i]]=n+1-InversePermutation[fPref[[i]]],{i,n}]
mScore//MatrixForm
fScore//MatrixForm

solMenFirst=StableMarriage[mPref,fPref]

StableMarriageQ[mPref_,fPref_,marriage_]:=(ans={True,{}};
n=Length[mPref];
marriageWomenFirst=Sort[Reverse/@marriage];
mScore=mPref;fScore=fPref;
Do[mScore[[i]]=n+1-InversePermutation[mPref[[i]]];
fScore[[i]]=n+1-InversePermutation[fPref[[i]]],{i,n}];
Do[spouses={marriage[[sw[[1]],2]],marriageWomenFirst[[sw[[2]],2]]};
If[(mScore[[sw[[1]],sw[[2]]]]>mScore[[sw[[1]],spouses[[1]]]])&&(fScore[[sw[[2]],sw[[1]]]]>fScore[[sw[[2]],spouses[[2]]]]),
ans={False,sw};Break[]],{sw,Tuples[Range[n],2]}];
ans)

StableMarriageQ[mPref,fPref,Transpose[{Range[5],solMenFirst}]]

solWomenFirst=StableMarriage[fPref,mPref]
StableMarriageQ[fPref,mPref,Transpose[{Range[5],solWomenFirst}]]

(∑_(i=1)^n)(mScore[[i,solMenFirst[[i]]]]+fScore[[i,InversePermutation[solMenFirst][[i]]]])
(∑_(i=1)^n)(fScore[[i,solWomenFirst[[i]]]]+mScore[[i,InversePermutation[solWomenFirst][[i]]]])

vbles=Flatten[Table[x[i,j],{i,n},{j,n}],1]

happiness=(∑_(i=1)^n)(∑_(j=1)^n)x[i,j] mScore[[i,j]]+(∑_(j=1)^n)(∑_(i=1)^n)x[j,i] fScore[[i,j]]

monogamy=Join[Table[(∑_(j=1)^n)x[i,j]==1,{i,n}],
Table[(∑_(i=1)^n)x[i,j]==1,{j,n}],Flatten[Table[0≤x[i,j]≤1,{i,n},{j,n}],1]];

soln=Maximize[{happiness,monogamy}, vbles]

(ans=Partition[vbles,n]/.soln[[2]])//MatrixForm

marriage=Position[ans,1]

StableMarriageQ[mPref,fPref,marriage]

ILP

n=4;A={10000,12345,654321,777777};
target=99999999;
vb=x/@Range[n];
obj=target-vb . A;
Minimize[{obj,obj≥0&&And@@Thread[vb≥0]},vb,Integers]

{21,165,128,18}.A

FrobeniusSolve[A,target,1]

{a,b,c,d}={(10^6),200347541,599854111,945121233};
Minimize[{k,k b==m a+y c+z d&&1≤k≤a&&1≤m&&0≤y&&0≤z},{k,m,y,z}, Integers][[2]]

vec=RandomInteger[(10^100),8];
v=x/@Range[Length[vec]-1];
k/.Minimize[{k,k vec[[2]]==v[[1]] vec[[1]]+Most[v].Drop[vec,2]&&1≤k≤vec[[1]]&&1≤v[[1]]&&And@@Thread[0≤Most[v]]},Prepend[v,k],Integers][[2]]

TSP

Needs["Combinatorica`"];

ILPSolToGraph[ILPsol_,n_, pts_]:=Graph[List/@Select[Tuples[Range[n],2],(x@@#/.ILPsol[[2]])==1&],List/@pts];

AllCycles[g_] := (g1=g;ans={};While[(cy=FindCycle[g1])≠{},AppendTo[ans, cy];g1= DeleteEdges[g1,Partition[cy,2,1]]];ans);

breakCycles[cycles_,n_] := Table[
Sum[x[i,j],{i,c},{j,Complement[Range[i+1,n],c]}]+Sum[x[j,i],{i,c},{j,Complement[Range[i-1],c]}]≥2, {c, cycles}];
 TSPILP[pts_, opts___]:=(n= Length[pts];count=1;cylist={};
vb=Flatten[Table[x[i,j],{i,1,n-1},{j,i+1,n}]];
objective=(∑_(i=1)^(n-1))(∑_(j=i+1)^n)x[i,j] Norm[N[pts[[i]]-pts[[j]]]];
constraint01=Table[0≤v≤1,{v,vb}];
constraintDeg=Table[(∑_(j=i+1)^n)x[i,j]+(∑_(j=1)^(i-1))x[j,i]==2,{i,n}];
sol=Minimize[objective,Join[constraint01,constraintDeg],vb,Integers];
While[fc=Rest/@ AllCycles[ILPSolToGraph[sol,n,pts]]; 
Length[fc[[1]]]≠n, 
cylist=Join[cylist,fc];
sol=Minimize[objective,Join[constraint01,constraintDeg,breakCycles[cylist,n]], vb,Integers];
edges=Select[Tuples[Range[n],2],(x@@# /. sol[[2]])==1 &];
image[count]=Graphics[Line[pts[[#]]& /@ edges]]; count++];
{Total[Norm /@ Differences[pts[[Append[fc[[1]], fc[[1,1]]]]]]], fc[[1]]});

SeedRandom[5];pts =RandomReal[10,{50,2}];
TSPILP[pts]

.  Case Study: Interval Methods for a SIAM Challenge

fSIAM[x_,y_]:=(E^(Sin[50 x]))+Sin[60 (E^y)]+Sin[70 Sin[x]]+Sin[Sin[80 y]]-Sin[10 (x+y)]+(1/4) ((x^2)+(y^2));

Plot3D[fSIAM[x,y],{x,0,1},{y,0,1}]

Plot3D[fSIAM[x,y],{x,-7,7},{y,-7,7},RegionFunction->(#3<10&)]

Min[Table[fSIAM[x,y],{x,-1,1,0.01},{y,-1,1,0.01}]]

Sin[Interval[{0.1,0.7}]]

Clear[f];
f[x_] :=Sin[x]+Cos[x]
a=Interval[{0, 2π}];
f[a]

FullSimplify[Maximize[f[x],x]]

Sort[Flatten[Table[{fSIAM[x,y], x,y},{x,-1,1,0.01},{y,-1,1,0.01}],1]][[1]]

Interval[-0.02]//InputForm

fSIAM[Interval[-0.02], Interval[0.21]]//InputForm

fSIAM[Interval[{-∞,-1.}],Interval[{-∞,∞}]]

Distribute[f[{a1,a2}, {a3,a4}], List]

bisect[Interval[{a_,b_}]]:={Interval[{a,Mean[{a,b}]}],Interval[{Mean[{a,b}],b}]}
subdivide[{X_Interval,Y_Interval}]:=Distribute[{bisect[X],bisect[Y]},List];

subdivide[{Interval[{2,4}], Interval[{5,15}]}]

LowestCriticalPoint[f_, {x_, a_, b_}, {y_, c_, d_},u_, tol_:(10^(-9))]:=(
rects=N[{ {Interval[{a,b}],Interval[{c,d}]}}];  (* the initial rectangle *)
fcn[{xx_,yy_}] := f/.{ x-> xx,y-> yy};  (* turn expression to function *) 
gradf[{xx_,yy_}]:=Evaluate[D[f,{{x,y}}]/.{x->xx, y-> yy}]; (* form gradient *)
{low,upp}={-∞,u};     (* initial interval for answer *)
While[upp-low>tol,   (* stop when tolerance met *)
rects=Join @@ (subdivide /@ rects);    (* subdivide rectangles *)
fvals=fcn /@ rects;    (* f-values on the rectangles *) 
upp=Min[upp,Min[Max/@fvals]];   (* update upper bound on the minimum *) 
pos=Flatten[Position[Min/@fvals,v_/;v≤upp ]];  (* find positions to discard *)
rects=rects[[pos]];   (* discard *)
fvals=fvals[[pos]];  (* update function values *)
pos= Flatten[Position[Apply[And ,IntervalMemberQ[gradf/@ rects,0],{1}], 
                                True]];  (* find positions to discard by gradient condition *) 
rects=rects[[pos]];  (* discard *)
low=Min[fvals[[pos]]]];  (* update lower bound on the minimum *)
{Interval[{low,upp}],rects}  (* returns bounds and locations *) );

LowestCriticalPoint[fSIAM[x,y],{x,-1,1},{y,-1,1},-3.24]

Optimize by Plotting

c=0;
p=Plot3D[fSIAM[x,y],{x,-1,1},{y,-1,1}, EvaluationMonitor:> c++];c

fPts=p[[1,1]];
Length[fPts]

seed = First[SortBy[fPts, Last]]

FindMinimum[fSIAM[x,y],{x,seed[[1]]},{y,seed[[2]]}]

.  Case Study: Shadowing Chaotic Maps

fQuad[x_]:=4  x (1-x);
der[x_]:=Evaluate[fQuad'[x]]
fIter[x_,n_]:=Nest[fQuad,x,n];
fTraj[x_,n_]:=NestList[fQuad,x,n];

fIter[0.1,100]
fIter[N[1/10,65],100]
val100=fIter[N[1/10,100],100]

sensList[x_,n_]:=Most[FoldList[Times,{1},der[fTraj[x,n]]]]

sensList[N[1/10,70],100][[-1]]

ϵ=(10^(-40));(1/ϵ)(fIter[N[(1/10)+ϵ,100],100]-val100)

noisy=SetPrecision[fTraj[0.1,100],100];
noisy[[-1]]

Shadow[noisy_, n_, start_] := (
residual[x0_?NumericQ] :=Block[{$MinPrecision = n,$MaxPrecision = n},
fTraj[x0,n]-Take[noisy,n+1]];
FindMinimum[0,{x0,SetPrecision[start, n]}, WorkingPrecision->n,
Method->{"LevenbergMarquardt","Residual"->residual[x0],"Jacobian"->sensList[x0,n]}])

sol50=Shadow[noisy,50,1/10]
shadowSeed50=x0/.sol50[[2]];

Do[sol=Shadow[noisy,nn,If[nn==50,1/10,x0/.sol[[2]]]],{nn,50,100,50}]
shadowSeed100=x0/.sol[[2]]

shadowTraj=SetPrecision[fTraj[shadowSeed100,100],100];
Max[Abs[shadowTraj-noisy]]

Show[ListPlot[fTraj[0.1,165],PlotStyle->{PointSize[0.008],Black}],ListLinePlot[fTraj[shadowSeed100,165],PlotStyle->{Thickness[0.002],Black}],Frame->True,AspectRatio->0.2,PlotRange->{-0.1,1.1},Axes->False,FrameTicks->{Automatic,{0,0.5,1},None,None},GridLines->{{150},{}}]

ListLinePlot[Log[10,Abs[SetPrecision[fTraj[0.1,150],100]-fTraj[shadowSeed100,150]]],PlotStyle->{Thickness[0.005],Black},Frame->True]

residual1[x0_?NumericQ,n_]:=fTraj[x0,n]-Take[noisy,n+1];
data=Table[Max[Abs[residual1[N[x0,100],100]]],{x0,(1/10)-(10^(-12)),(1/10)+(10^(-12)),(10^(-16))}];

ListPlot[data,Frame->True,Axes->False,PlotRange->{-0.1,1.2},PlotStyle->{Black,PointSize[0.003]},Epilog->{PointSize[0.02],Red,Point[{(((1/10)-shadowSeed100)/(10^(-16 ))  (20000/2)),Max[Abs[residual1[shadowSeed100,100]]]}]},FrameTicks->{{{10000,(1/10)},{0,"(1/10) - (10^(-16))"},{20000,"(1/10) + (10^(-16))"}},{0,0.5,1},None,None}]

p=27;npts=32000;len=100;
data=Table[Max[Abs[residual1[N[x0,len],len]]],{x0,shadowSeed100-(10^(-p)),shadowSeed100+(10^(-p)),2 (10^(-p))/npts}];

ListPlot[data,Frame->True,PlotStyle->PointSize[0.003],Axes->False,PlotRange->{-0.1,1.1},FrameTicks->{{{npts/2,"shadow seed"},{0,StringForm["seed - (10^(-``))",p]},{npts,StringForm["seed + (10^(-``))",p]}},{0,0.5,1},None,None},Epilog->{PointSize[0.02],Red,Point[{npts/2,Max[Abs[residual1[shadowSeed100,100]]]}]}]

p=15;npts=2000;length=50;
data=Table[Max[Abs[residual1[N[x0,length],length]]],{x0,shadowSeed50-(10^(-p)),shadowSeed50+(10^(-p)),2 (10^(-p))/npts}];
ListLinePlot[data,Frame->True,PlotStyle->Thickness[0.005],Axes->False,PlotRange->{{-20,npts 0.55},{-0.1,0.9}},FrameTicks->{{{1,StringForm["seed - (10^(-``))",p]},{npts,StringForm["seed + (10^(-``))",p]},
{ 1+(npts/2)+((1.1157/100)((npts/2))),1/10}},{0,0.5,0.8},{{1+npts/2,"shadow seed"}},None},GridLines->{{npts/2},{}},AspectRatio->0.2]

.  Case Study: Finding the Best Cubic

Plot[z=(E^(I θ));Abs[(z^3)+2 (z^2)- z+2-(1/(Gamma[z]))], {θ,0, 2π}, PlotStyle->Thick]

maxerror[{a_?NumericQ,b_,c_,d_}]:=(count++;temp=Max[Table[(FindMaximum[z=(E^(I θ));Abs[a (z^3)+b (z^2)+c z+d-(1/(Gamma[z]))],{θ,θ1-0.03,θ1+0.03}][[1]]), {θ1, π/10.,9π/10,π/10}]];
If[!NumericQ[currentbest]||temp<currentbest,currentbest=temp];temp);

currentbest=∞;count=0;maxerror[{1,2,-1,2}]

Clear[a,b,c,d]

currentbest=∞;count=0;
Timing[Monitor[NMinimize[maxerror[{a,b,c,d}],{{a,-2,2},{b,-2,2},{c,-2,2},{d,-2,2}},Method->{"DifferentialEvolution","PostProcess"->False,"CrossProbability"->0,"ScalingFactor"->0.4,"SearchPoints"->100},PrecisionGoal->∞,AccuracyGoal->∞,MaxIterations->120],{NumberForm[currentbest,9],count}]]

{count,NumberForm[currentbest,9]}