testforestunit.pas

maths lib with source

        SetLength(Y, 1+1);
        I:=0;
        while I<=NPoints-1 do
        begin
            XY[I,0] := 3*RandomReal;
            if XY[I,0]<=1 then
            begin
                XY[I,1] := 0;
            end
            else
            begin
                if XY[I,0]<=2 then
                begin
                    if RandomReal<XY[I,0]-1 then
                    begin
                        XY[I,1] := 1;
                    end
                    else
                    begin
                        XY[I,1] := 0;
                    end;
                end
                else
                begin
                    XY[I,1] := 1;
                end;
            end;
            Inc(I);
        end;
        
        //
        // Test
        //
        DFBuildInternal(XY, NPoints, 1, 2, NTrees, Round(0.05*NPoints), 1, 0, Info, DF, Rep);
        if Info<=0 then
        begin
            Err := True;
            Exit;
        end;
        X[0] := 0.0;
        while X[0]<=3.0 do
        begin
            DFProcess(DF, X, Y);
            
            //
            // Test for basic properties
            //
            S := 0;
            J:=0;
            while J<=1 do
            begin
                if Y[J]<0 then
                begin
                    Err := True;
                    Exit;
                end;
                S := S+Y[J];
                Inc(J);
            end;
            if AbsReal(S-1)>1000*MachineEpsilon then
            begin
                Err := True;
                Exit;
            end;
            
            //
            // test for good correlation with results
            //
            if X[0]<1 then
            begin
                Err := Err or (Y[0]<0.8);
            end;
            if (X[0]>=1) and (X[0]<=2) then
            begin
                Err := Err or (AbsReal(Y[1]-(X[0]-1))>0.5);
            end;
            if X[0]>2 then
            begin
                Err := Err or (Y[1]<0.8);
            end;
            X[0] := X[0]+0.01;
        end;
        Inc(Pass);
    end;
end;


(*************************************************************************
Basic test:  tests  generalization ability on a simple classification task
(no noise):
* |x|<1, |y|<1
* x^2+y^2<=0.25 - P(class=0)=1
* x^2+y^2>0.25  - P(class=0)=0
*************************************************************************)
procedure BasicTest3(var Err : Boolean);
var
    Pass : Integer;
    PassCount : Integer;
    XY : TReal2DArray;
    NPoints : Integer;
    NTrees : Integer;
    I : Integer;
    J : Integer;
    K : Integer;
    S : Double;
    Info : Integer;
    DF : DecisionForest;
    X : TReal1DArray;
    Y : TReal1DArray;
    Rep : DFReport;
    TestGridSize : Integer;
    R : Double;
begin
    PassCount := 1;
    TestGridSize := 50;
    Pass:=1;
    while Pass<=PassCount do
    begin
        
        //
        // select npoints and ntrees
        //
        NPoints := 1000;
        NTrees := 100;
        
        //
        // Prepare task
        //
        SetLength(XY, NPoints-1+1, 2+1);
        SetLength(X, 1+1);
        SetLength(Y, 1+1);
        I:=0;
        while I<=NPoints-1 do
        begin
            XY[I,0] := 2*RandomReal-1;
            XY[I,1] := 2*RandomReal-1;
            if Sqr(XY[I,0])+Sqr(XY[I,1])<=0.25 then
            begin
                XY[I,2] := 0;
            end
            else
            begin
                XY[I,2] := 1;
            end;
            Inc(I);
        end;
        
        //
        // Test
        //
        DFBuildInternal(XY, NPoints, 2, 2, NTrees, Round(0.1*NPoints), 1, 0, Info, DF, Rep);
        if Info<=0 then
        begin
            Err := True;
            Exit;
        end;
        I:=-TestGridSize div 2;
        while I<=TestGridSize div 2 do
        begin
            J:=-TestGridSize div 2;
            while J<=TestGridSize div 2 do
            begin
                X[0] := I/(TestGridSize div 2);
                X[1] := J/(TestGridSize div 2);
                DFProcess(DF, X, Y);
                
                //
                // Test for basic properties
                //
                S := 0;
                K:=0;
                while K<=1 do
                begin
                    if Y[K]<0 then
                    begin
                        Err := True;
                        Exit;
                    end;
                    S := S+Y[K];
                    Inc(K);
                end;
                if AbsReal(S-1)>1000*MachineEpsilon then
                begin
                    Err := True;
                    Exit;
                end;
                
                //
                // test for good correlation with results
                //
                R := Sqrt(Sqr(X[0])+Sqr(X[1]));
                if R<0.5*0.5 then
                begin
                    Err := Err or (Y[0]<0.6);
                end;
                if R>0.5*1.5 then
                begin
                    Err := Err or (Y[1]<0.6);
                end;
                Inc(J);
            end;
            Inc(I);
        end;
        Inc(Pass);
    end;
end;


(*************************************************************************
Basic test: simple regression task without noise:
* |x|<1, |y|<1
* F(x,y) = x^2+y
*************************************************************************)
procedure BasicTest4(var Err : Boolean);
var
    Pass : Integer;
    PassCount : Integer;
    XY : TReal2DArray;
    NPoints : Integer;
    NTrees : Integer;
    NS : Integer;
    StrongC : Integer;
    I : Integer;
    J : Integer;
    K : Integer;
    S : Double;
    Info : Integer;
    DF : DecisionForest;
    DF2 : DecisionForest;
    X : TReal1DArray;
    Y : TReal1DArray;
    Rep : DFReport;
    Rep2 : DFReport;
    TestGridSize : Integer;
    MaxErr : Double;
    MaxErr2 : Double;
    AvgErr : Double;
    AvgErr2 : Double;
    Cnt : Integer;
    EY : Double;
begin
    PassCount := 1;
    TestGridSize := 50;
    Pass:=1;
    while Pass<=PassCount do
    begin
        
        //
        // select npoints and ntrees
        //
        NPoints := 1000;
        NTrees := 100;
        NS := Round(0.1*NPoints);
        StrongC := 1;
        
        //
        // Prepare task
        //
        SetLength(XY, NPoints-1+1, 2+1);
        SetLength(X, 1+1);
        SetLength(Y, 0+1);
        I:=0;
        while I<=NPoints-1 do
        begin
            XY[I,0] := 2*RandomReal-1;
            XY[I,1] := 2*RandomReal-1;
            XY[I,2] := Sqr(XY[I,0])+XY[I,1];
            Inc(I);
        end;
        
        //
        // Test
        //
        DFBuildInternal(XY, NPoints, 2, 1, NTrees, NS, 1, 0, Info, DF, Rep);
        if Info<=0 then
        begin
            Err := True;
            Exit;
        end;
        DFBuildInternal(XY, NPoints, 2, 1, NTrees, NS, 1, StrongC, Info, DF2, Rep2);
        if Info<=0 then
        begin
            Err := True;
            Exit;
        end;
        MaxErr := 0;
        MaxErr2 := 0;
        AvgErr := 0;
        AvgErr2 := 0;
        Cnt := 0;
        I:=Round(-0.7*TestGridSize/2);
        while I<=Round(0.7*TestGridSize/2) do
        begin
            J:=Round(-0.7*TestGridSize/2);
            while J<=Round(0.7*TestGridSize/2) do
            begin
                X[0] := I/(TestGridSize div 2);
                X[1] := J/(TestGridSize div 2);
                EY := Sqr(X[0])+X[1];
                DFProcess(DF, X, Y);
                MaxErr := Max(MaxErr, AbsReal(Y[0]-EY));
                AvgErr := AvgErr+AbsReal(Y[0]-EY);
                DFProcess(DF2, X, Y);
                MaxErr2 := Max(MaxErr2, AbsReal(Y[0]-EY));
                AvgErr2 := AvgErr2+AbsReal(Y[0]-EY);
                Cnt := Cnt+1;
                Inc(J);
            end;
            Inc(I);
        end;
        AvgErr := AvgErr/Cnt;
        AvgErr2 := AvgErr2/Cnt;
        Err := Err or (MaxErr>0.2);
        Err := Err or (MaxErr2>0.2);
        Err := Err or (AvgErr>0.1);
        Err := Err or (AvgErr2>0.1);
        Inc(Pass);
    end;
end;


(*************************************************************************
Basic test: extended variable selection leads to better results.

Next task CAN be solved without EVS but it is very unlikely. With EVS
it can be easily and exactly solved.

Task matrix:
    1 0 0 0 ... 0   0
    0 1 0 0 ... 0   1
    0 0 1 0 ... 0   2
    0 0 0 1 ... 0   3
    0 0 0 0 ... 1   N-1
*************************************************************************)
procedure BasicTest5(var Err : Boolean);
var
    XY : TReal2DArray;
    NVars : Integer;
    NPoints : Integer;
    NFeatures : Integer;
    NSample : Integer;
    NTrees : Integer;
    EVS : Integer;
    I : Integer;
    J : Integer;
    EFlag : Boolean;
    Info : Integer;
    DF : DecisionForest;
    X : TReal1DArray;
    Y : TReal1DArray;
    Rep : DFReport;
begin
    
    //
    // select npoints and ntrees
    //
    NPoints := 50;
    NVars := NPoints;
    NTrees := 1;
    NSample := NPoints;
    EVS := 2;
    NFeatures := 1;
    
    //
    // Prepare task
    //
    SetLength(XY, NPoints-1+1, NVars+1);
    SetLength(X, NVars-1+1);
    SetLength(Y, 0+1);
    I:=0;
    while I<=NPoints-1 do
    begin
        J:=0;
        while J<=NVars-1 do
        begin
            XY[I,J] := 0;
            Inc(J);
        end;
        XY[I,I] := 1;
        XY[I,NVars] := I;
        Inc(I);
    end;
    
    //
    // Without EVS
    //
    DFBuildInternal(XY, NPoints, NVars, 1, NTrees, NSample, NFeatures, 0, Info, DF, Rep);
    if Info<=0 then
    begin
        Err := True;
        Exit;
    end;
    EFlag := False;
    I:=0;
    while I<=NPoints-1 do
    begin
        APVMove(@X[0], 0, NVars-1, @XY[I][0], 0, NVars-1);
        DFProcess(DF, X, Y);
        if AbsReal(Y[0]-XY[I,NVars])>1000*MachineEpsilon then
        begin
            EFlag := True;
        end;
        Inc(I);
    end;
    if  not EFlag then
    begin
        Err := True;
        Exit;
    end;
    
    //
    // With EVS
    //
    DFBuildInternal(XY, NPoints, NVars, 1, NTrees, NSample, NFeatures, EVS, Info, DF, Rep);
    if Info<=0 then
    begin
        Err := True;
        Exit;
    end;
    EFlag := False;
    I:=0;
    while I<=NPoints-1 do
    begin
        APVMove(@X[0], 0, NVars-1, @XY[I][0], 0, NVars-1);
        DFProcess(DF, X, Y);
        if AbsReal(Y[0]-XY[I,NVars])>1000*MachineEpsilon then
        begin
            EFlag := True;
        end;
        Inc(I);
    end;
    if EFlag then
    begin
        Err := True;
        Exit;
    end;
end;


(*************************************************************************
Random normal number
*************************************************************************)
function RNormal():Double;
var
    U : Double;
    V : Double;
    S : Double;
    X1 : Double;
    X2 : Double;
begin
    while True do
    begin
        U := 2*RandomReal-1;
        V := 2*RandomReal-1;
        S := Sqr(u)+Sqr(v);
        if (S>0) and (S<1) then
        begin
            S := Sqrt(-2*Ln(S)/S);
            X1 := U*S;
            X2 := V*S;
            Break;
        end;
    end;
    Result := X1;
end;


(*************************************************************************
Random point from sphere
*************************************************************************)
function RSphere(var XY : TReal2DArray; N : Integer; I : Integer):Double;
var
    J : Integer;
    V : Double;
begin
    J:=0;
    while J<=N-1 do
    begin
        XY[I,J] := RNormal;
        Inc(J);
    end;
    V := APVDotProduct(@XY[I][0], 0, N-1, @XY[I][0], 0, N-1);
    V := RandomReal/Sqrt(V);
    APVMul(@XY[I][0], 0, N-1, V);
end;


(*************************************************************************
Unsets DF
*************************************************************************)
procedure UnsetDF(var DF : DecisionForest);
var
    XY : TReal2DArray;
    Info : Integer;
    Rep : DFReport;
begin
    SetLength(XY, 0+1, 1+1);
    XY[0,0] := 0;
    XY[0,1] := 0;
    DFBuildInternal(XY, 1, 1, 1, 1, 1, 1, 0, Info, DF, Rep);
end;


(*************************************************************************
Silent unit test
*************************************************************************)
function testforestunit_test_silent():Boolean;
begin
    Result := TestForest(True);
end;


(*************************************************************************
Unit test
*************************************************************************)
function testforestunit_test():Boolean;
begin
    Result := TestForest(False);
end;


end.