Description

scaled LSE min LSEMinSc is defined as

f := LSEMin(t*x) / t
   = -log(exp(-t*x1)+exp(-t*x2)+...) / t

Small Model of Type : GAMS

Category : GAMS Test library

Main file : fnlseminsc.gms

$title 'Test correctness of LSEMinSc intrinsic' (FNLSEMINSC,SEQ=916)

$onText
  scaled LSE min LSEMinSc is defined as

  f := LSEMin(t*x) / t
     = -log(exp(-t*x1)+exp(-t*x2)+...) / t
$offText

Sets
   P
   V
   arg 'expected content of set V' / v00*v19 /
   tst(*)
   ;
alias (V,Vp);
alias (u,*);
scalars
   t
   aErr0
   mx0
   rErr0
   ;
parameters
   xIn(P,V)
   x(V)

   wantFunc(P)
   wntFunc
   gotFunc

   wantGrad(P,V)
   wntGrad(V)
   gotGrad(V)

   wantHess(P,V,V)
   wntHess(V,V)
   gotHess(V,V)

   aErr1(V)
   aErr1Show(V)
   mx1(V)
   rErr1(V)
   rErr1Show(V)

   aErr2(V,V)
   aErr2Show(V,V)
   mx2(V,V)
   rErr2(V,V)
   rErr2Show(V,V)
   ;

$gdxIn fnlseminsc.gdx
$load P V xIn wantFunc wantGrad wantHess
$gdxIn

abort$[card(arg) <> card(V)] 'sets arg and V are not equal';
tst(arg) = yes;
tst(V) = no;
abort$[card(tst)] 'sets arg and V are not equal', tst;

* ------------------------ LSEMinSc -------------------------
loop {P,
  x(V) = xIn(P,V);
  t = x('v00');
  x('v00') = 0;
  wntFunc = wantFunc(P);
  gotFunc = LSEMinSc.value(       t,x('v01'),x('v02'),x('v03'),x('v04'),
                           x('v05'),x('v06'),x('v07'),x('v08'),x('v09'),
                           x('v10'),x('v11'),x('v12'),x('v13'),x('v14'),
                           x('v15'),x('v16'),x('v17'),x('v18'),x('v19') );

  wntGrad(V) = wantGrad(P,V);
  loop{V,
    gotGrad(V) = LSEMinSc.grad(ord(V):       t,x('v01'),x('v02'),x('v03'),x('v04'),
                                      x('v05'),x('v06'),x('v07'),x('v08'),x('v09'),
                                      x('v10'),x('v11'),x('v12'),x('v13'),x('v14'),
                                      x('v15'),x('v16'),x('v17'),x('v18'),x('v19') );
  };

  wntHess(V,Vp) = wantHess(P,V,Vp);
  loop{(V,Vp),
    gotHess(V,Vp) = LSEMinSc.hess(ord(V):ord(Vp):       t,x('v01'),x('v02'),x('v03'),x('v04'),
                                                 x('v05'),x('v06'),x('v07'),x('v08'),x('v09'),
                                                 x('v10'),x('v11'),x('v12'),x('v13'),x('v14'),
                                                 x('v15'),x('v16'),x('v17'),x('v18'),x('v19') );
  };

  aErr0 = abs(gotFunc-wntFunc);
  repeat {
    break$[aErr0 <= 1e-200];
    mx0 = max(abs(gotFunc),abs(wntFunc));
    rErr0 = aErr0 / mx0;
    break$[rErr0 <= 5e-16];
    abort  'wrong function value in LSEMinSc', t, x, gotFunc, wntFunc, aErr0, rErr0;
  until yes };

  aErr1(V) = abs(gotGrad(V)-wntGrad(V));
  aErr1Show(V) = aErr1(V)$[aErr1(V) > 1e-200];
  repeat {
    break$[card(aErr1Show) = 0];
    mx1(V) = max(abs(gotGrad(V)),abs(wntGrad(V)));
    rErr1(V) = [aErr1(V) / mx1(V)]$aErr1Show(V);
    rErr1Show(V) = rErr1(V)$[rErr1(V) > 5e-16];
    break$[card(rErr1Show) = 0];
    abort  'wrong gradient value in LSEMinSc', t, x, gotGrad, wntGrad, aErr1Show, rErr1Show;
  until yes };

  aErr2(V,Vp) = abs(gotHess(V,Vp)-wntHess(V,Vp));
  aErr2Show(V,Vp) = aErr2(V,Vp)$[aErr2(V,Vp) > 1e-200];
  repeat {
    break$[card(aErr2Show) = 0];
    mx2(V,Vp) = max(abs(gotHess(V,Vp)),abs(wntHess(V,Vp)));
    rErr2(V,Vp) = [aErr2(V,Vp) / mx2(V,Vp)]$aErr2Show(V,Vp);
    rErr2Show(V,Vp) = rErr2(V,Vp)$[rErr2(V,Vp) > 1e-15];
    break$[card(rErr2Show) = 0];
    abort  'wrong Hessian value in LSEMinSc', t, x, gotHess, wntHess, aErr2Show, rErr2Show;
  until yes };
};