Skip to main content
1 of 2
Michael E2
  • 244.8k
  • 18
  • 351
  • 774

Here's a slight refactoring of the OP's solution.

Expressions like #[[5]] are hard to read and therefore hard to debug. One can use a function with symbolic names for arguments to make the easier to understand.

I think it's better to return raw output data of a function and leave it formatting etc. to processing the returned data. So I moved TableForm outside the function gmQuadraticF.

gmQuadraticF[A_, b_, x0_, eps_, iter_] := Module[{g, NormG, f, test},
   f[{step_, α_, x_, g_, squareNormG_, v_}] :=
    With[{stepfactor = Norm[g]^2/g.A.g},
     With[{ng = stepfactor*g},
      With[{xnext = x - ng},
       With[{grad = A.xnext + b},
        {step + 1,                   (*update Iteration counts*)
         stepfactor,                 (*α step size*)
         xnext,                      (*update x*)
         grad,                       (*update gradient*)
         Norm[grad],                 (*update gradient norm*)
         1/2 xnext.A.xnext + b.xnext (*object function value*)}
        ]]]];
   test[{step_, α_, x_, g_, squareNormG_, v_}] := 
    step <= iter && squareNormG >= eps;
   g = A.x0 + b;
   NormG = Norm[g];
   NestWhileList[
    f,
    {0,                   (* initial step number *)
     (NormG^2)/g.A.g,     (*α step size*)
     x0,                  (*initial x*)
     g,                   (*intial gradient*)
     NormG,               (*intial gradient norm*)
     1/2 x0.A.x0 + b.x0}, (*object function value*)
    test]
   ];
gmQuadraticF[TableHeadings] = {"Iteration", "Step Size", "X", 
   "Gradient", "Gradient Norm", "Object Value"};

Example:

SeedRandom[0];
dim = 2;
aa = RandomReal[{-1, 1}, {dim, dim}];
aa = aa\[Transpose].aa;
bb = RandomReal[1, dim];
x0 = Developer`ToPackedArray@{13., -31.};
eps = 1.*^-12;

TableForm[
 gmQuadraticF[aa, bb, x0, eps, 200],
 TableHeadings -> {None, gmQuadraticF[TableHeadings]}
 ]

Mathematica graphics

Here's a Mathematica-like version with precision control:

ClearAll[gmQuadraticF, igmQuadraticF];
Options@gmQuadraticF = {WorkingPrecision -> Automatic};
gmQuadraticF[A_, b_, x0_, eps_, iter_Integer, OptionsPattern[]] := 
  Module[{wp},
   wp = OptionValue[WorkingPrecision];
   wp = wp /. 
     Automatic -> (Precision[{A, b, x0}] /. 
        Infinity -> MachinePrecision);
   Block[{$MaxPrecision = wp, $MinPrecision = wp},
    igmQuadraticF[
     SetPrecision[A, wp],
     SetPrecision[b, wp],
     SetPrecision[x0, wp],
     eps, iter]
    ]
   ];
igmQuadraticF[A_, b_, x0_, eps_, iter_] := 
  Module[{g, NormG, f, test, stepfactor, ng, xnext, grad},
   f[{step_, α_, x_, g_, sqaureNormG_, v_}] := (
     stepfactor = Norm[g]^2/g.A.g;
     ng = stepfactor*g;
     xnext = x - ng;
     grad = A.xnext + b;
     {step + 1,                   (*update Iteration counts*)
      stepfactor,                 (*α step size*)
      xnext,                      (*update x*)
      grad,                       (*update gradient*)
      Norm[grad],                 (*update gradient norm*)
      1/2 xnext.A.xnext + b.xnext (*object function value*)});
   test[{step_, α_, x_, g_, squareNormG_, v_}] := 
    step <= iter && squareNormG >= eps;
   g = A.x0 + b;
   NormG = Norm[g];
   NestWhileList[
    f,
    {0,                   (* initial step number *)
     (NormG^2)/g.A.g,     (*α step size*)
     x0,                  (*initial x*)
     g,                   (*intial gradient*)
     NormG,               (*intial gradient norm*)
     1/2 x0.A.x0 + b.x0}, (*object function value*)
    test]
   ];
Michael E2
  • 244.8k
  • 18
  • 351
  • 774