testmlpeunit.pas

maths lib with source

unit testmlpeunit;
interface
uses Math, Ap, Sysutils, mlpbase, trinverse, lbfgs, cholesky, spdsolve, mlptrain, tsort, descriptivestatistics, bdss, mlpe;

function TestMLPE(Silent : Boolean):Boolean;
function testmlpeunit_test_silent():Boolean;
function testmlpeunit_test():Boolean;

implementation

procedure CreateEnsemble(var Ensemble : MLPEnsemble;
     NKind : Integer;
     A1 : Double;
     A2 : Double;
     NIn : Integer;
     NHid1 : Integer;
     NHid2 : Integer;
     NOut : Integer;
     EC : Integer);forward;
procedure UnsetEnsemble(var Ensemble : MLPEnsemble);forward;
procedure TestInformational(NKind : Integer;
     NIn : Integer;
     NHid1 : Integer;
     NHid2 : Integer;
     NOut : Integer;
     EC : Integer;
     PassCount : Integer;
     var Err : Boolean);forward;
procedure TestProcessing(NKind : Integer;
     NIn : Integer;
     NHid1 : Integer;
     NHid2 : Integer;
     NOut : Integer;
     EC : Integer;
     PassCount : Integer;
     var Err : Boolean);forward;


function TestMLPE(Silent : Boolean):Boolean;
var
    WasErrors : Boolean;
    PassCount : Integer;
    MaxN : Integer;
    MaxHid : Integer;
    NF : Integer;
    NHid : Integer;
    NL : Integer;
    NHid1 : Integer;
    NHid2 : Integer;
    EC : Integer;
    NKind : Integer;
    AlgType : Integer;
    TaskType : Integer;
    Pass : Integer;
    Ensemble : MLPEnsemble;
    Rep : MLPReport;
    OOBRep : MLPCVReport;
    XY : TReal2DArray;
    I : Integer;
    J : Integer;
    NIn : Integer;
    NOut : Integer;
    NPoints : Integer;
    E : Double;
    Info : Integer;
    NLess : Integer;
    NAll : Integer;
    NClasses : Integer;
    AllSame : Boolean;
    InfErrors : Boolean;
    ProcErrors : Boolean;
    TrnErrors : Boolean;
begin
    WasErrors := False;
    InfErrors := False;
    ProcErrors := False;
    TrnErrors := False;
    PassCount := 10;
    MaxN := 4;
    MaxHid := 4;
    
    //
    // General MLP ensembles tests
    //
    NF:=1;
    while NF<=MaxN do
    begin
        NL:=1;
        while NL<=MaxN do
        begin
            NHid1:=0;
            while NHid1<=MaxHid do
            begin
                NHid2:=0;
                while NHid2<=0 do
                begin
                    NKind:=0;
                    while NKind<=3 do
                    begin
                        EC:=1;
                        while EC<=3 do
                        begin
                            
                            //
                            //  Skip meaningless parameters combinations
                            //
                            if (NKind=1) and (NL<2) then
                            begin
                                Inc(EC);
                                Continue;
                            end;
                            if (NHid1=0) and (NHid2<>0) then
                            begin
                                Inc(EC);
                                Continue;
                            end;
                            
                            //
                            // Tests
                            //
                            TestInformational(NKind, NF, NHid1, NHid2, NL, EC, PassCount, InfErrors);
                            TestProcessing(NKind, NF, NHid1, NHid2, NL, EC, PassCount, ProcErrors);
                            Inc(EC);
                        end;
                        Inc(NKind);
                    end;
                    Inc(NHid2);
                end;
                Inc(NHid1);
            end;
            Inc(NL);
        end;
        Inc(NF);
    end;
    
    //
    // network training must reduce error
    // test on random regression task
    //
    NIn := 3;
    NOut := 2;
    NHid := 5;
    NPoints := 100;
    NLess := 0;
    NAll := 0;
    Pass:=1;
    while Pass<=10 do
    begin
        AlgType:=0;
        while AlgType<=1 do
        begin
            TaskType:=0;
            while TaskType<=1 do
            begin
                if TaskType=0 then
                begin
                    SetLength(XY, NPoints-1+1, NIn+NOut-1+1);
                    I:=0;
                    while I<=NPoints-1 do
                    begin
                        J:=0;
                        while J<=NIn+NOut-1 do
                        begin
                            XY[I,J] := 2*RandomReal-1;
                            Inc(J);
                        end;
                        Inc(I);
                    end;
                    MLPECreate1(NIn, NHid, NOut, 1+RandomInteger(3), Ensemble);
                end
                else
                begin
                    SetLength(XY, NPoints-1+1, NIn+1);
                    NClasses := 2+RandomInteger(2);
                    I:=0;
                    while I<=NPoints-1 do
                    begin
                        J:=0;
                        while J<=NIn-1 do
                        begin
                            XY[I,J] := 2*RandomReal-1;
                            Inc(J);
                        end;
                        XY[I,NIn] := RandomInteger(NClasses);
                        Inc(I);
                    end;
                    MLPECreateC1(NIn, NHid, NClasses, 1+RandomInteger(3), Ensemble);
                end;
                E := MLPERMSError(Ensemble, XY, NPoints);
                if AlgType=0 then
                begin
                    MLPEBaggingLM(Ensemble, XY, NPoints, 0.001, 1, Info, Rep, OOBRep);
                end
                else
                begin
                    MLPEBaggingLBFGS(Ensemble, XY, NPoints, 0.001, 1, 0.01, 0, Info, Rep, OOBRep);
                end;
                if Info<0 then
                begin
                    TrnErrors := True;
                end
                else
                begin
                    if MLPERMSError(Ensemble, XY, NPoints)<E then
                    begin
                        NLess := NLess+1;
                    end;
                end;
                NAll := NAll+1;
                Inc(TaskType);
            end;
            Inc(AlgType);
        end;
        Inc(Pass);
    end;
    TrnErrors := TrnErrors or (NAll-NLess>0.3*NAll);
    
    //
    // Final report
    //
    WasErrors := InfErrors or ProcErrors or TrnErrors;
    if  not Silent then
    begin
        Write(Format('MLP ENSEMBLE TEST'#13#10'',[]));
        Write(Format('INFORMATIONAL FUNCTIONS:                 ',[]));
        if  not InfErrors then
        begin
            Write(Format('OK'#13#10'',[]));
        end
        else
        begin
            Write(Format('FAILED'#13#10'',[]));
        end;
        Write(Format('BASIC PROCESSING:                        ',[]));
        if  not ProcErrors then
        begin
            Write(Format('OK'#13#10'',[]));
        end
        else
        begin
            Write(Format('FAILED'#13#10'',[]));
        end;
        Write(Format('TRAINING:                                ',[]));
        if  not TrnErrors 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;


(*************************************************************************
Network creation
*************************************************************************)
procedure CreateEnsemble(var Ensemble : MLPEnsemble;
     NKind : Integer;
     A1 : Double;
     A2 : Double;
     NIn : Integer;
     NHid1 : Integer;
     NHid2 : Integer;
     NOut : Integer;
     EC : Integer);
begin
    Assert((NIn>0) and (NHid1>=0) and (NHid2>=0) and (NOut>0), 'CreateNetwork error');
    Assert((NHid1<>0) or (NHid2=0), 'CreateNetwork error');
    Assert((NKind<>1) or (NOut>=2), 'CreateNetwork error');
    if NHid1=0 then
    begin
        
        //
        // No hidden layers
        //
        if NKind=0 then
        begin
            MLPECreate0(NIn, NOut, EC, Ensemble);
        end
        else
        begin
            if NKind=1 then
            begin
                MLPECreateC0(NIn, NOut, EC, Ensemble);
            end
            else
            begin
                if NKind=2 then
                begin
                    MLPECreateB0(NIn, NOut, A1, A2, EC, Ensemble);
                end
                else
                begin
                    if NKind=3 then
                    begin
                        MLPECreateR0(NIn, NOut, A1, A2, EC, Ensemble);
                    end;
                end;
            end;
        end;
        Exit;
    end;
    if NHid2=0 then
    begin
        
        //
        // One hidden layer
        //
        if NKind=0 then
        begin
            MLPECreate1(NIn, NHid1, NOut, EC, Ensemble);
        end
        else
        begin
            if NKind=1 then
            begin
                MLPECreateC1(NIn, NHid1, NOut, EC, Ensemble);
            end
            else
            begin
                if NKind=2 then
                begin
                    MLPECreateB1(NIn, NHid1, NOut, A1, A2, EC, Ensemble);
                end
                else
                begin
                    if NKind=3 then
                    begin
                        MLPECreateR1(NIn, NHid1, NOut, A1, A2, EC, Ensemble);
                    end;
                end;
            end;
        end;
        Exit;
    end;
    
    //
    // Two hidden layers
    //
    if NKind=0 then
    begin
        MLPECreate2(NIn, NHid1, NHid2, NOut, EC, Ensemble);
    end
    else
    begin
        if NKind=1 then
        begin
            MLPECreateC2(NIn, NHid1, NHid2, NOut, EC, Ensemble);
        end
        else
        begin