Common

fontLabels=Directive[FontFamily->"Libertinus Serif",FontSize->22];
fontTicks=Directive[FontFamily->"Libertinus Serif",FontSize->18];

(* https://mathematica.stackexchange.com/questions/54545/is-it-possible-to-define-a-new-plottheme *)
Begin["System`PlotThemeDump`"];
Themes`ThemeRules;(*preload Theme system*)

resolvePlotTheme["myTheme",def:_String]:=
Themes`SetWeight[Join[
{ImageSize->Large},
{LabelStyle->fontLabels},
{TicksStyle->fontTicks},
{FrameTicksStyle->fontTicks},
{PlotStyle->Directive[PointSize[0.013],Thick]},
(* 102 is the default grey level of Mathematica *)
{AxesStyle->Directive[AbsoluteThickness[0.3],GrayLevel[(102/255)]]}
]
,$ComponentWeight];

End[];

it[var_]:=Style[var,FontSlant->Italic]
bf[var_]:=Style[var,FontWeight->Bold]
bi[var_]:=bf[it[var]]

equalNumberForm[x_,numbLeft_,numbRight_]:=Module[{digits,exponent,lengthLeft},
If[!NumberQ[x],Return[x]];
{digits,exponent}=RealDigits[x];

(* Make sure that the list is long enough *)
digits=ArrayPad[digits,{({{\[Piecewise], ({{0, exponent≥0}, {Abs[exponent], True}})}}),numbRight}];
exponent=Max[exponent,0];
lengthLeft=Length[digits[[1;;exponent]]];

StringJoin[ToString[#]&/@ConstantArray["0",numbLeft-lengthLeft]]<>
StringJoin[ToString[#]&/@digits[[1;;lengthLeft]]]<>"."<>
StringJoin[ToString[#]&/@digits[[exponent+1;;exponent+numbRight]]]
]

rasterizeBackground[graphics_,res_: 450]:=Block[{g,fig},
fig=graphics;

If[Head@graphics==Legended,
g=fig[[1]],
g=fig
];

(* Rasterize only the image parts of the figure (https://mathematica.stackexchange.com/questions/13744/rasterized-image-together-with-vector-graphics-axes/13746#13746) *)
g=Show[
Rasterize[
Show[g,
PlotRangePadding->0,
ImagePadding->0,
ImageMargins->0,
LabelStyle->Opacity[0],
FrameTicksStyle->Opacity[0],
FrameStyle->Opacity[0],
AxesStyle->Opacity[0],
TicksStyle->Opacity[0],
PlotRangeClipping->False
],
ImageResolution->res
]/.Raster[data_,rect_,rest__]:>Raster[data,Transpose@OptionValue[AbsoluteOptions[g,PlotRange],PlotRange],rest],Sequence@@Options[g],Sequence@@Options[g,PlotRange]
];

If[Head@graphics==Legended,
fig[[1]]=g,
fig=g
];

fig
]

Data

η=0.001;
ηa=0.05;
ηA=0.001;

error[w1_,w2_]:=3*(w1^2)+10*(w2^2)

grad1=D[error[w1,w2],{w1}]

grad2=D[error[w1,w2],{w2}]

w1Start=-15;
w2Start=20;

iterations=700;

clear[]:=Block[{},
(* This removes all subscript values (https://mathematica.stackexchange.com/a/38650/41589) *)
Clear["Subscript"];

(Subscript[grad, 1])[w1_,w2_]=grad1;
(Subscript[grad, 2])[w1_,w2_]=grad2;
]

wSeries[alpha_]:=Block[{},
clear[];

(Subscript[m, i_])[0]:=0;
(Subscript[w, 1])[0]:=w1Start;
(Subscript[w, 2])[0]:=w2Start;

(Subscript[m, i_])[t_]:=(Subscript[m, i])[t]=alpha*(Subscript[m, i])[t-1]+(Subscript[grad, i])[(Subscript[w, 1])[t-1],(Subscript[w, 2])[t-1]];
(Subscript[w, i_])[t_]:=(Subscript[w, i])[t]=(Subscript[w, i])[t-1]-η*(Subscript[m, i])[t];

Table[{(Subscript[w, 1])[t],(Subscript[w, 2])[t],error[(Subscript[w, 1])[t],(Subscript[w, 2])[t]]},{t,0,iterations}]
]

RMSProb[beta_]:=Block[{},
clear[];

(Subscript[s, i_])[0]:=0;
(Subscript[w, 1])[0]:=w1Start;
(Subscript[w, 2])[0]:=w2Start;

(Subscript[s, i_])[t_]:=(Subscript[s, i])[t]=beta*(Subscript[s, i])[t-1]+(1-beta)*(((Subscript[grad, i])[(Subscript[w, 1])[t-1],(Subscript[w, 2])[t-1]])^2);
(Subscript[w, i_])[t_]:=(Subscript[w, i])[t]=(Subscript[w, i])[t-1]-ηa*(((Subscript[grad, i])[(Subscript[w, 1])[t-1],(Subscript[w, 2])[t-1]])/(Sqrt[(Subscript[s, i])[t]+(10^(-8))]));

Table[{(Subscript[w, 1])[t],(Subscript[w, 2])[t],error[(Subscript[w, 1])[t],(Subscript[w, 2])[t]]},{t,0,iterations}]
]

adam[beta1_,beta2_,eta_]:=Block[{},
clear[];

(Subscript[s, i_])[0]:=0;
(Subscript[m, i_])[0]:=0;
(Subscript[w, 1])[0]:=w1Start;
(Subscript[w, 2])[0]:=w2Start;

(Subscript[m, i_])[t_]:=(Subscript[m, i])[t]=beta1*(Subscript[m, i])[t-1]+(1-beta1)*(Subscript[grad, i])[(Subscript[w, 1])[t-1],(Subscript[w, 2])[t-1]];
(Subscript[s, i_])[t_]:=(Subscript[s, i])[t]=beta2*(Subscript[s, i])[t-1]+(1-beta2)*(((Subscript[grad, i])[(Subscript[w, 1])[t-1],(Subscript[w, 2])[t-1]])^2);
(Subscript[w, i_])[t_]:=(Subscript[w, i])[t]=(Subscript[w, i])[t-1]-eta*((((Subscript[m, i])[t])/(1-(beta1^t)))/(Sqrt[(((Subscript[s, i])[t])/(1-(beta2^t)))+(10^(-8))]));

Table[{(Subscript[w, 1])[t],(Subscript[w, 2])[t],error[(Subscript[w, 1])[t],(Subscript[w, 2])[t]]},{t,0,iterations}]
]

Momentum example

Classical gradient descent

wClassic=wSeries[0][[1;;3]];
Round[wClassic,0.01]

{(Subscript[grad, 1])[(Subscript[w, 1])[0],(Subscript[w, 2])[0]],(Subscript[grad, 2])[(Subscript[w, 1])[0],(Subscript[w, 2])[0]]}

Round[{(Subscript[grad, 1])[(Subscript[w, 1])[1],(Subscript[w, 2])[1]],(Subscript[grad, 2])[(Subscript[w, 1])[1],(Subscript[w, 2])[1]]},0.01]

Momentum optimization

wMomentum=wSeries[0.9][[1;;3]];
Round[wMomentum, 0.01]

{(Subscript[grad, 1])[(Subscript[w, 1])[0],(Subscript[w, 2])[0]],(Subscript[grad, 2])[(Subscript[w, 1])[0],(Subscript[w, 2])[0]]}

{(Subscript[m, 1])[1],(Subscript[m, 2])[1]}

The gradients are the same in the first two iterations as only of the third iterations the weights differ.

{(Subscript[grad, 1])[(Subscript[w, 1])[1],(Subscript[w, 2])[1]],(Subscript[grad, 2])[(Subscript[w, 1])[1],(Subscript[w, 2])[1]]}

Round[{(Subscript[m, 1])[2],(Subscript[m, 2])[2]},0.01]

Visualization

wClassic=wClassic[[;;,1;;2]]

wMomentum=wMomentum[[;;,1;;2]]

colorVec1B=;
colorVec1A=Darker[colorVec1B,0.15];
colorVec2B=;
colorVec2A=Darker[colorVec2B,0.25];

Show[
ListPlot[{
Callout[wClassic[[1]],Row[{bi["w"],"(0)"}]],
Callout[wClassic[[2]],Row[{Subscript[bi["w"],"c"],"(1) = ",Subscript[bi["w"],"m"],"(1)"}]],
Callout[wClassic[[3]],Row[{Subscript[bi["w"],"c"],"(2)"}]],
Callout[wMomentum[[3]],Row[{Subscript[bi["w"],"m"],"(2)"}],Before]
},
PlotTheme->"myTheme",
GridLines->Automatic,
PlotRange->{{-15.02,-14.71},{18.75,20.05}},
PlotRangePadding->None,
AspectRatio->1,
FrameLabel->{"(Subscript[w, 1])",None,None,"(Subscript[w, 2])"},
Frame->{True,False,False,True},
FrameTicks->{{None,All},{All,None}}
],
Graphics[{
{
AbsoluteThickness[1.5],
colorVec2A,
Arrow[{wMomentum[[1]],wMomentum[[2]]}],
colorVec2B,
Arrow[{wMomentum[[2]],wMomentum[[3]]}],
Style[Text[Row[{bi["m"],"(2)"}],{-14.765,19.06}],FontFamily->"Libertinus Serif",FontSize->22]
},
Style[
Text[
Row[{
Style[Row[{"∇",it["E"],"(",bi["w"],"(0))"}],colorVec1A],
" = ",
Style[Row[{bi["m"],"(1)"}],colorVec2A]
}],
{-14.9,19.8}
],
FontFamily->"Libertinus Serif",
FontSize->22
],
{
AbsoluteThickness[2.5],
AbsoluteDashing[20],
colorVec1A,
Arrow[{wClassic[[1]],wClassic[[2]]}],
colorVec1B,
Arrow[{wClassic[[2]],wClassic[[3]]}],
Style[Text[Row[{"∇",it["E"],"(",Subscript[bi["w"],"c"],"(1))"}],{-14.905,19.4}],FontFamily->"Libertinus Serif",FontSize->22]
}
}]
]

RMSProb example

Adaptive learning rate

rms=RMSProb[0.9][[1;;3,1;;2]];
rmsRound=Round[rms,0.01]

{(Subscript[grad, 1])[(Subscript[w, 1])[0],(Subscript[w, 2])[0]],(Subscript[grad, 2])[(Subscript[w, 1])[0],(Subscript[w, 2])[0]]}

{(Subscript[s, 1])[1],(Subscript[s, 2])[1]}

rmsGrad1=Round[{(Subscript[grad, 1])[rmsRound[[2,1]],rmsRound[[2,2]]],(Subscript[grad, 2])[rmsRound[[2,1]],rmsRound[[2,2]]]},0.01]

rmsScale2=Round[0.9*{(Subscript[s, 1])[1],(Subscript[s, 2])[1]}+0.1*(rmsGrad1^2),0.01]//FullForm

Round[{(Subscript[s, 1])[2],(Subscript[s, 2])[2]},0.01]

Round[Round[rms,0.01][[2]]-0.05*(rmsGrad1/(Sqrt[rmsScale2+(10^(-8))])),0.01]

Visualization

wClassic

rms

Show[
ListPlot[{
Callout[wClassic[[1]],Row[{bi["w"],"(0)"}],After],
Callout[wClassic[[2]],Row[{Subscript[bi["w"],"c"],"(1)"}]],
Callout[wClassic[[3]],Row[{Subscript[bi["w"],"c"],"(2)"}]],
Callout[rms[[2]],Row[{Subscript[bi["w"],"a"],"(1)"}]],
Callout[rms[[3]],Row[{Subscript[bi["w"],"a"],"(2)"}],Below]
},
PlotTheme->"myTheme",
GridLines->Automatic,
PlotRange->{{-15.02,-14.71},{19.15,20.06}},
PlotRangePadding->None,
AspectRatio->1,
FrameLabel->{"(Subscript[w, 1])",None,None,"(Subscript[w, 2])"},
Frame->{True,False,False,True},
FrameTicks->{{None,All},{All,None}}
],
Graphics[{
AbsoluteThickness[1.5],

colorVec1A,
Arrow[{wClassic[[1]],wClassic[[2]]}],
Style[Text[Row[{"∇",it["E"],"(",bi["w"],"(0))"}],{-14.92,19.78}],FontFamily->"Libertinus Serif",FontSize->22],
colorVec1B,
Arrow[{wClassic[[2]],wClassic[[3]]}],
Style[Text[Row[{"∇",it["E"],"(",Subscript[bi["w"],"c"],"(1))"}],{-14.84,19.43}],FontFamily->"Libertinus Serif",FontSize->22],

colorVec2A,
Arrow[{rms[[1]],rms[[2]]}],
Style[Text[Row[{bi["v"],"(1)"}],{-14.9,19.94}],FontFamily->"Libertinus Serif",FontSize->22],
colorVec2B,
Arrow[{rms[[2]],rms[[3]]}],
Style[Text[Row[{bi["v"],"(2)"}],{-14.78,19.82}],FontFamily->"Libertinus Serif",FontSize->22]
}]
]

Testing

wSeries[0];
gradsClassic=Table[{(Subscript[m, 1])[t],(Subscript[m, 2])[t]},{t,1,700}];

RMSProb[0.9];
gradsRMS=Table[0.05*{(((Subscript[grad, 1])[(Subscript[wr, 1])[t-1],(Subscript[wr, 2])[t-1]])/(Sqrt[(Subscript[s, 1])[t]+(10^(-8))])),(((Subscript[grad, 2])[(Subscript[wr, 1])[t-1],(Subscript[wr, 2])[t-1]])/(Sqrt[(Subscript[s, 2])[t]+(10^(-8))]))},{t,1,700}];

ListLinePlot[Table[{(Subscript[s, 1])[t],(Subscript[s, 2])[t]},{t,400,700}]\[Transpose],PlotRange->All]

ListLinePlot[{Abs@gradsClassic[[;;,1]],Abs@gradsClassic[[;;,2]],Abs@gradsRMS[[;;,1]],Abs@gradsRMS[[;;,2]]},PlotRange->All]

ListLinePlot[{gradsRMS[[;;,1]],gradsRMS[[;;,2]]},PlotRange->All]

ListLinePlot[(Norm[#-{0,0}]&)/@RMSProb[0.9][[;;,1;;2]],PlotRange->{0,2}]

ListLinePlot[RMSProb[0.9][[;;,3]],PlotRange->{0,0.1}]

Plots

Trajectories

Manipulate[
Show[
Plot3D[error[w1,w2],{w1,-20,10},{w2,-10,20},ImageSize->800,PlotStyle->Opacity[0.5]],
ListPointPlot3D[{wSeries[0],wSeries[α]},PlotStyle->PointSize[0.01]]
]
,{α,0,1},TrackedSymbols:>{α}]

min=FindMinimum[error[w1,w2],{w1,w2}][[2,;;,2]]

alphas={0,0.6,0.9};

color1=Darker[,0.25];
color2=Darker[,0.25];
color3=Darker[,0.25];
lineColors={color1,color2,color3}

colorMin=;

plotBackground=DensityPlot[error[w1,w2],{w1,-21,21},{w2,-21,21},
PlotTheme->"myTheme",
PlotLegends->Placed[
BarLegend[Automatic,
LabelStyle->fontTicks,
LegendMargins->{{50,0},{0,0}},
LegendMarkerSize->520,
LegendLabel->Style[Row[{it["E"],"(",bi["w"],")"}],fontLabels]
],
Above
],
FrameLabel->{"(Subscript[w, 1])","(Subscript[w, 2])"},
PlotPoints->100,
MeshFunctions->{#3&,#3&},
Mesh->Automatic,
PerformanceGoal->"Quality"
];
plotMin=ListPlot[{min},
PlotTheme->"myTheme",
PlotStyle->Directive[colorMin,PointSize[0.02]]
];

momentSeries=Table[wSeries[α][[;;,1;;2]],{α,alphas}];
momentSeries//Dimensions

lightMax=0.4;
colorMap[v_,tThresh_]:=({{\[Piecewise], ({{(v/tThresh)*lightMax, v≤tThresh}, {lightMax, True}})}})

Plot[colorMap[v,0.15],{v,0,1},PlotRange->All]

plotTrajectoryMomentum=Show[
plotBackground,
ListPlot[Table[
Style[
momentSeries[[s,t,;;]],
Lighter[lineColors[[s]],colorMap[(t/iterations),0.15]]
],
{s,1,Length[momentSeries]},
{t,1,iterations}
],
PlotTheme->"myTheme",
PlotRange->All,
PlotLegends->PointLegend[
Join[lineColors,{colorMin}],
Join[Table["α = "<>ToString[equalNumberForm[α,1,1]],{α,alphas}],{Row[{Superscript[bi["w"],"*"]," (minimum)"}]}],
LegendMarkerSize->15
],
BaseStyle->{FontOpacity->0.999}
],
plotMin
]

(*plotTrajectoryMomentum[[1]]=rasterizeBackground[plotTrajectoryMomentum[[1]]];
Export[
FileNameJoin[{NotebookDirectory[],"Optimizers_MomentumTrajectory.pdf"}],
plotTrajectoryMomentum
];*)

adaptiveSeries={wSeries[0][[;;,1;;2]],RMSProb[0][[;;,1;;2]],RMSProb[0.9][[;;,1;;2]]};
adaptiveSeries//Dimensions

plotTrajectoryAdaptive=Show[
plotBackground,
ListPlot[Table[
Style[
adaptiveSeries[[s,t,;;]],
Lighter[lineColors[[s]],colorMap[t/iterations,400/700]]
],
{s,1,Length[adaptiveSeries]},
{t,1,iterations}
],
PlotTheme->"myTheme",
PlotRange->All,
PlotLegends->PointLegend[
Join[lineColors,{colorMin}],
Join[{"Classic","β = 0","β = 0.9"},{Row[{Superscript[bi["w"],"*"]," (minimum)"}]}],
LegendMarkerSize->15
],
BaseStyle->{FontOpacity->0.999}
],
plotMin
]

(*plotTrajectoryAdaptive[[1]]=rasterizeBackground[plotTrajectoryAdaptive[[1]]];
Export[
FileNameJoin[{NotebookDirectory[],"Optimizers_AdaptiveTrajectory.pdf"}],
plotTrajectoryAdaptive
];*)

ListLinePlot[{wSeries[0][[;;,3]],RMSProb[0][[;;,3]],RMSProb[0.9][[;;,3]]},PlotStyle->lineColors]

Speed improvements

plotErrorComparison=ListLinePlot[Table[wSeries[α][[;;,3]],{α,{0,0.5,0.9}}],
PlotTheme->"myTheme",
PlotRange->{Automatic,{0,615}},
PlotStyle->lineColors,
AxesLabel->{it["t"],Row[{it["E"],"(",bi["w"],"(t))"}]},
GridLines->Automatic,
PlotLegends->Table["α = "<>ToString[equalNumberForm[α,1,1]],{α,alphas}]
]

(*Export[FileNameJoin[{NotebookDirectory[],"MomentumOptimizer_SpeedImprovements.svg"}],plotErrorComparison];*)

Concept of acceleration/deceleration

(Subscript[Cm, α_])[g1_,g2_]:=({{\[Piecewise], ({{(α*g1+g2)-g1, g1≥0}, {g1-(α*g1+g2), g1<0}})}})

sampleData=Table[(Subscript[Cm, α])[g1,g2],{α,0,1},{g1,-3,3,0.1},{g2,-3,3,0.1}];
maxAbsValue=Max[Abs[Min@sampleData],Abs[Max@sampleData]];
lower=-maxAbsValue;
upper=maxAbsValue;
plotAccDec[α_]:=DensityPlot[(Subscript[Cm, α])[g1,g2],{g1,-3,3},{g2,-3,3},
PlotLegends->BarLegend[{Automatic,{lower,upper}},
LegendMarkerSize->462,
LegendMargins->{{0,0},{42,0}},
LabelStyle->fontTicks,
LegendLabel->Placed[
Style[Row[{Subscript[it["C"],it["m"]],"((Subscript[g, 1]),(Subscript[g, 2]))"}],fontLabels],
After
]
],
PlotTheme->"myTheme",
ImageSize->500,
ColorFunctionScaling->False,
ColorFunction->(ColorData["TemperatureMap"][((#-lower)/(upper-lower))]&),
Exclusions->None,
PlotPoints->100,
FrameLabel->{"(Subscript[g, 1])","(Subscript[g, 2])"}
]

plotCases=plotAccDec[1]

(*Export[
FileNameJoin[{NotebookDirectory[],"Optimizers_MomentumCases.pdf"}],
rasterizeBackground[plotCases]
];*)

Parameter β in the adaptive learning scheme

plotComp[beta_]:=Module[{comp,β,minValue,maxValue,scale,fontTicks,fontLabels},
comp[g1_,g2_]:=Abs[(g2/(Sqrt[β*((1-β)*(g1^2))+(1-β)*(g2^2)+(10^(-8))]))]-Abs[g2];

minValue=Minimize[{comp[g1,g2]/.{β->0},-6≤g1≤6,-6≤g2≤6},{g1,g2}][[1]]//N;
maxValue=Maximize[{comp[g1,g2]/.{β->0.9},-6≤g1≤6,-6≤g2≤6},{g1,g2}][[1]]//N;
scale[x_]:=({{\[Piecewise], ({{(x/maxValue)*0.5+0.5, x≥0}, {((x-minValue)/(0-minValue))*0.5, x<0}})}});

fontTicks=Directive[FontFamily->"Libertinus Serif",FontSize->24];
fontLabels=Directive[FontFamily->"Libertinus Serif",FontSize->28];

DensityPlot[comp[g1,g2]/.{β->beta},{g1,-6,6},{g2,-6,6},
PlotTheme->"myTheme",
LabelStyle->fontLabels,
FrameTicksStyle->fontTicks,
ColorFunctionScaling->False,
ColorFunction->Function[{x},ColorData["TemperatureMap"][scale[x]]],
Exclusions->None,
PlotPoints->500,
FrameLabel->{"(Subscript[g, 1])","(Subscript[g, 2])"},
PlotLegends->Placed[
BarLegend[Automatic,
LegendMarkerSize->525,
LegendMargins->{{50,0},{0,0}},
LegendLabel->Placed[
Style[Row[{Subscript[it["C"],it["a"]],"((Subscript[g, 1]),(Subscript[g, 2]))"}],fontLabels],
Above
],
LabelStyle->fontTicks
]
,Above]
]
]

(*Do[
Export[
FileNameJoin[{NotebookDirectory[],"Optimizers_AdaptiveDensity"<>ToString[Round[β*10]]<>".pdf"}],
rasterizeBackground[plotComp[β]]
]
,{β,{0,0.6,0.9}}]*)