testforestunit.pas

maths lib with source

unit testforestunit;
interface
uses Math, Ap, Sysutils, tsort, descriptivestatistics, bdss, dforest;

function TestForest(Silent : Boolean):Boolean;
function testforestunit_test_silent():Boolean;
function testforestunit_test():Boolean;

implementation

procedure TestProcessing(var Err : Boolean);forward;
procedure BasicTest1(NVars : Integer;
     NClasses : Integer;
     PassCount : Integer;
     var Err : Boolean);forward;
procedure BasicTest2(var Err : Boolean);forward;
procedure BasicTest3(var Err : Boolean);forward;
procedure BasicTest4(var Err : Boolean);forward;
procedure BasicTest5(var Err : Boolean);forward;
function RNormal():Double;forward;
function RSphere(var XY : TReal2DArray;
     N : Integer;
     I : Integer):Double;forward;
procedure UnsetDF(var DF : DecisionForest);forward;


function TestForest(Silent : Boolean):Boolean;
var
    NCMax : Integer;
    NVMax : Integer;
    PassCount : Integer;
    NVars : Integer;
    NClasses : Integer;
    WasErrors : Boolean;
    BasicErrors : Boolean;
    ProcErrors : Boolean;
    I : Integer;
    J : Integer;
begin
    
    //
    // Primary settings
    //
    NVMax := 4;
    NCMax := 3;
    PassCount := 10;
    BasicErrors := False;
    ProcErrors := False;
    WasErrors := False;
    
    //
    // Tests
    //
    TestProcessing(ProcErrors);
    NVars:=1;
    while NVars<=NVMax do
    begin
        NClasses:=1;
        while NClasses<=NCMax do
        begin
            BasicTest1(NVars, NClasses, PassCount, BasicErrors);
            Inc(NClasses);
        end;
        Inc(NVars);
    end;
    BasicTest2(BasicErrors);
    BasicTest3(BasicErrors);
    BasicTest4(BasicErrors);
    BasicTest5(BasicErrors);
    
    //
    // Final report
    //
    WasErrors := BasicErrors or ProcErrors;
    if  not Silent then
    begin
        Write(Format('RANDOM FOREST TEST'#13#10'',[]));
        Write(Format('TOTAL RESULTS:                           ',[]));
        if  not WasErrors then
        begin
            Write(Format('OK'#13#10'',[]));
        end
        else
        begin
            Write(Format('FAILED'#13#10'',[]));
        end;
        Write(Format('* PROCESSING FUNCTIONS:                  ',[]));
        if  not ProcErrors then
        begin
            Write(Format('OK'#13#10'',[]));
        end
        else
        begin
            Write(Format('FAILED'#13#10'',[]));
        end;
        Write(Format('* BASIC TESTS:                           ',[]));
        if  not BasicErrors then
        begin
            Write(Format('OK'#13#10'',[]));
        end
        else
        begin
            Write(Format('FAILED'#13#10'',[]));
        end;
        if WasErrors then
        begin
            Write(Format('TEST SUMMARY: FAILED'#13#10'',[]));
        end
        else
        begin
            Write(Format('TEST SUMMARY: PASSED'#13#10'',[]));
        end;
        Write(Format(''#13#10''#13#10'',[]));
    end;
    Result :=  not WasErrors;
end;


(*************************************************************************
Processing functions test
*************************************************************************)
procedure TestProcessing(var Err : Boolean);
var
    NVars : Integer;
    NClasses : Integer;
    NSample : Integer;
    NTrees : Integer;
    NFeatures : Integer;
    Flags : Integer;
    DF1 : DecisionForest;
    DF2 : DecisionForest;
    NPoints : Integer;
    XY : TReal2DArray;
    Pass : Integer;
    PassCount : Integer;
    I : Integer;
    J : Integer;
    AllSame : Boolean;
    RLen : Integer;
    Info : Integer;
    Rep : DFReport;
    X1 : TReal1DArray;
    X2 : TReal1DArray;
    Y1 : TReal1DArray;
    Y2 : TReal1DArray;
    RA : TReal1DArray;
    RA2 : TReal1DArray;
    V : Double;
begin
    PassCount := 100;
    
    //
    // Main cycle
    //
    Pass:=1;
    while Pass<=PassCount do
    begin
        
        //
        // initialize parameters
        //
        NVars := 1+RandomInteger(5);
        NClasses := 1+RandomInteger(3);
        NTrees := 1+RandomInteger(4);
        NFeatures := 1+RandomInteger(NVars);
        Flags := 0;
        if RandomReal>0.5 then
        begin
            Flags := Flags+2;
        end;
        
        //
        // Initialize arrays and data
        //
        NPoints := 10+RandomInteger(50);
        NSample := Max(10, RandomInteger(NPoints));
        SetLength(X1, NVars-1+1);
        SetLength(X2, NVars-1+1);
        SetLength(Y1, NClasses-1+1);
        SetLength(Y2, NClasses-1+1);
        SetLength(XY, NPoints-1+1, NVars+1);
        I:=0;
        while I<=NPoints-1 do
        begin
            J:=0;
            while J<=NVars-1 do
            begin
                if J mod 2=0 then
                begin
                    XY[I,J] := 2*RandomReal-1;
                end
                else
                begin
                    XY[I,J] := RandomInteger(2);
                end;
                Inc(J);
            end;
            if NClasses=1 then
            begin
                XY[I,NVars] := 2*RandomReal-1;
            end
            else
            begin
                XY[I,NVars] := RandomInteger(NClasses);
            end;
            Inc(I);
        end;
        
        //
        // create forest
        //
        DFBuildInternal(XY, NPoints, NVars, NClasses, NTrees, NSample, NFeatures, Flags, Info, DF1, Rep);
        if Info<=0 then
        begin
            Err := True;
            Exit;
        end;
        
        //
        // Same inputs leads to same outputs
        //
        I:=0;
        while I<=NVars-1 do
        begin
            X1[I] := 2*RandomReal-1;
            X2[I] := X1[I];
            Inc(I);
        end;
        I:=0;
        while I<=NClasses-1 do
        begin
            Y1[I] := 2*RandomReal-1;
            Y2[I] := 2*RandomReal-1;
            Inc(I);
        end;
        DFProcess(DF1, X1, Y1);
        DFProcess(DF1, X2, Y2);
        AllSame := True;
        I:=0;
        while I<=NClasses-1 do
        begin
            AllSame := AllSame and (Y1[I]=Y2[I]);
            Inc(I);
        end;
        Err := Err or  not AllSame;
        
        //
        // Same inputs on original forest leads to same outputs
        // on copy created using DFCopy
        //
        UnsetDF(DF2);
        DFCopy(DF1, DF2);
        I:=0;
        while I<=NVars-1 do
        begin
            X1[I] := 2*RandomReal-1;
            X2[I] := X1[I];
            Inc(I);
        end;
        I:=0;
        while I<=NClasses-1 do
        begin
            Y1[I] := 2*RandomReal-1;
            Y2[I] := 2*RandomReal-1;
            Inc(I);
        end;
        DFProcess(DF1, X1, Y1);
        DFProcess(DF2, X2, Y2);
        AllSame := True;
        I:=0;
        while I<=NClasses-1 do
        begin
            AllSame := AllSame and (Y1[I]=Y2[I]);
            Inc(I);
        end;
        Err := Err or  not AllSame;
        
        //
        // Same inputs on original forest leads to same outputs
        // on copy created using DFSerialize
        //
        UnsetDF(DF2);
        SetLength(RA, 0+1);
        RA[0] := 0;
        RLen := 0;
        DFSerialize(DF1, RA, RLen);
        SetLength(RA2, RLen-1+1);
        I:=0;
        while I<=RLen-1 do
        begin
            RA2[I] := RA[I];
            Inc(I);
        end;
        DFUnserialize(RA2, DF2);
        I:=0;
        while I<=NVars-1 do
        begin
            X1[I] := 2*RandomReal-1;
            X2[I] := X1[I];
            Inc(I);
        end;
        I:=0;
        while I<=NClasses-1 do
        begin
            Y1[I] := 2*RandomReal-1;
            Y2[I] := 2*RandomReal-1;
            Inc(I);
        end;
        DFProcess(DF1, X1, Y1);
        DFProcess(DF2, X2, Y2);
        AllSame := True;
        I:=0;
        while I<=NClasses-1 do
        begin
            AllSame := AllSame and (Y1[I]=Y2[I]);
            Inc(I);
        end;
        Err := Err or  not AllSame;
        
        //
        // Normalization properties
        //
        if NClasses>1 then
        begin
            I:=0;
            while I<=NVars-1 do
            begin
                X1[I] := 2*RandomReal-1;
                Inc(I);
            end;
            DFProcess(DF1, X1, Y1);
            V := 0;
            I:=0;
            while I<=NClasses-1 do
            begin
                V := V+Y1[I];
                Err := Err or (Y1[I]<0);
                Inc(I);
            end;
            Err := Err or (AbsReal(V-1)>1000*MachineEpsilon);
        end;
        Inc(Pass);
    end;
end;


(*************************************************************************
Basic test:  one-tree forest built using full sample must remember all the
training cases
*************************************************************************)
procedure BasicTest1(NVars : Integer;
     NClasses : Integer;
     PassCount : Integer;
     var Err : Boolean);
var
    Pass : Integer;
    XY : TReal2DArray;
    NPoints : Integer;
    I : Integer;
    J : Integer;
    K : Integer;
    S : Double;
    Info : Integer;
    DF : DecisionForest;
    X : TReal1DArray;
    Y : TReal1DArray;
    Rep : DFReport;
    HasSame : Boolean;
begin
    if NClasses=1 then
    begin
        
        //
        // only classification tasks
        //
        Exit;
    end;
    Pass:=1;
    while Pass<=PassCount do
    begin
        
        //
        // select number of points
        //
        if (Pass<=3) and (PassCount>3) then
        begin
            NPoints := Pass;
        end
        else
        begin
            NPoints := 100+RandomInteger(100);
        end;
        
        //
        // Prepare task
        //
        SetLength(XY, NPoints-1+1, NVars+1);
        SetLength(X, NVars-1+1);
        SetLength(Y, NClasses-1+1);
        I:=0;
        while I<=NPoints-1 do
        begin
            J:=0;
            while J<=NVars-1 do
            begin
                XY[I,J] := 2*RandomReal-1;
                Inc(J);
            end;
            XY[I,NVars] := RandomInteger(NClasses);
            Inc(I);
        end;
        
        //
        // Test
        //
        DFBuildInternal(XY, NPoints, NVars, NClasses, 1, NPoints, 1, 1, Info, DF, Rep);
        if Info<=0 then
        begin
            Err := True;
            Exit;
        end;
        I:=0;
        while I<=NPoints-1 do
        begin
            APVMove(@X[0], 0, NVars-1, @XY[I][0], 0, NVars-1);
            DFProcess(DF, X, Y);
            S := 0;
            J:=0;
            while J<=NClasses-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;
            if AbsReal(Y[Round(XY[I,NVars])]-1)>1000*MachineEpsilon then
            begin
                
                //
                // not an error if there exists such K,J that XY[K,J]=XY[I,J]
                // (may be we just can't distinguish two tied values).
                //
                // definitely error otherwise.
                //
                HasSame := False;
                K:=0;
                while K<=NPoints-1 do
                begin
                    if K<>I then
                    begin
                        J:=0;
                        while J<=NVars-1 do
                        begin
                            if XY[K,J]=XY[I,J] then
                            begin
                                HasSame := True;
                            end;
                            Inc(J);
                        end;
                    end;
                    Inc(K);
                end;
                if  not HasSame then
                begin
                    Err := True;
                    Exit;
                end;
            end;
            Inc(I);
        end;
        Inc(Pass);
    end;
end;


(*************************************************************************
Basic test:  tests generalization ability on a simple noisy classification
task:
* 0<x<1 - P(class=0)=1
* 1<x<2 - P(class=0)=2-x
* 2<x<3 - P(class=0)=0
*************************************************************************)
procedure BasicTest2(var Err : Boolean);
var
    Pass : Integer;
    PassCount : Integer;
    XY : TReal2DArray;
    NPoints : Integer;
    NTrees : Integer;
    I : Integer;
    J : Integer;
    S : Double;
    Info : Integer;
    DF : DecisionForest;
    X : TReal1DArray;
    Y : TReal1DArray;
    Rep : DFReport;
    HasSame : Boolean;
begin
    PassCount := 1;
    Pass:=1;
    while Pass<=PassCount do
    begin
        
        //
        // select npoints and ntrees
        //
        NPoints := 300;
        NTrees := 50;
        
        //
        // Prepare task
        //
        SetLength(XY, NPoints-1+1, 1+1);
        SetLength(X, 0+1);