scnred02.gms : Scenred2 test - tree reduction and zero values

Description

Simple check of tree reduction in SCENRED

We first check that the obvious reduction is taken, first when
the node to be removed has nonzero random values and then all the cases where
one of the values is zero.

Contributor: Steve Dirkse


Small Model of Type : GAMS


Category : GAMS Test library


Main file : scnred02.gms

$title Scenred test - tree reduction and zero values (SCNRED02,SEQ=434)

$onText
Simple check of tree reduction in SCENRED

We first check that the obvious reduction is taken, first when
the node to be removed has nonzero random values and then all the cases where
one of the values is zero.

Contributor: Steve Dirkse
$offText

sets
  g  'goods' / g1, g2 /,
  n  'nodes' /
     n0     'root - stage 1',
    (n1*n5) 'stage 2'
  /
  stage2(n) / (n1*n5) /,
  ancestor(n,n)  'input to scenred, in (child,parent) order'
  newAncestor(n,n)  'output from scenred'
  wantAnc(n,n) 'expected new tree' /
    (n1*n4).n0
  /
  ancDiff(n,n)
  ;
alias (n,n2);
parameters
  prob(n)   node probabilities /
    n0       1
    (n1*n4)  0.24
    n5       0.04
  /
  newProb(n)  'node probabilities output from scenred'
  pErr(n)     'probability wanted - got'
  rData(g,n)  'random data' /
    g1.(n1,n2) .1
    g1.(n3,n4) 5
    g2.(n1,n3) .1
    g2.(n2,n4) 5
    g1.n5      0
    g2.n5      5
  /
  ;

ancestor(stage2(n),'n0') = yes;

* LOAD SCENRED SYMBOLS *
$set srprefix scnred02
$libInclude scenred

* SCENRED2 METHOD CHOICE *
scenRedParms('reduction_method') = 1;
scenRedParms('red_num_leaves')   = 4;

scalar tiny / 1e-3 /;

* test one: add node with parms [tiny,5], should merge with node n2
rData('g1','n5') = tiny;
rData('g2','n5') = 5;

$libInclude scenred %srprefix% tree_con n ancestor prob newancestor newprob rData

ancDiff(n,n2) = wantAnc(n,n2) - newAncestor(n,n2);
abort$[card(ancDiff) or (card(wantAnc)-card(newAncestor))] 'bad newAncestor';
pErr(n) = prob(n);  pErr('n5') = 0;  pErr('n2') = .28;
pErr(n) = abs(pErr(n)-newProb(n));
abort$[smax{n, pErr(n)} > 1e-7] 'bad newProb';

* test two: add node with parms [5,tiny], should merge with node n3
rData('g1','n5') = 5;
rData('g2','n5') = tiny;

$libInclude scenred %srprefix% tree_con n ancestor prob newancestor newprob rData

ancDiff(n,n2) = wantAnc(n,n2) - newAncestor(n,n2);
abort$[card(ancDiff) or (card(wantAnc)-card(newAncestor))] 'bad newAncestor';
pErr(n) = prob(n);  pErr('n5') = 0;  pErr('n3') = .28;
pErr(n) = abs(pErr(n)-newProb(n));
abort$[smax{n, pErr(n)} > 1e-7] 'bad newProb';

* test three: add node with parms [0,5], should merge with node n2
rData('g1','n5') = 0;
rData('g2','n5') = 5;

$libInclude scenred %srprefix% tree_con n ancestor prob newancestor newprob rData

ancDiff(n,n2) = wantAnc(n,n2) - newAncestor(n,n2);
abort$[card(ancDiff) or (card(wantAnc)-card(newAncestor))] 'bad newAncestor';
pErr(n) = prob(n);  pErr('n5') = 0;  pErr('n2') = .28;
pErr(n) = abs(pErr(n)-newProb(n));
abort$[smax{n, pErr(n)} > 1e-7] 'bad newProb';

* test four: add node with parms [5,0], should merge with node n3
rData('g1','n5') = 5;
rData('g2','n5') = 0;

$libInclude scenred %srprefix% tree_con n ancestor prob newancestor newprob rData

ancDiff(n,n2) = wantAnc(n,n2) - newAncestor(n,n2);
abort$[card(ancDiff) or (card(wantAnc)-card(newAncestor))] 'bad newAncestor';
pErr(n) = prob(n);  pErr('n5') = 0;  pErr('n3') = .28;
pErr(n) = abs(pErr(n)-newProb(n));
abort$[smax{n, pErr(n)} > 1e-7] 'bad newProb';