Attribute VB_Name = "mAP"
 Option Explicit

Public Type Complex
    X As Double
    Y As Double
End Type

Public Type RCommState
    Stage As Long
    BA() As Boolean
    IA() As Long
    RA() As Double
    CA() As Complex
End Type

Public Type ALGLIBDataset
    NIn As Long
    NOut As Long
    NClasses As Long
    
    Trn() As Double
    TST() As Double
    Val() As Double
    AllDataset() As Double
    
    TrnSize As Long
    TstSize As Long
    ValSize As Long
    TotalSize As Long
End Type
'Private Tmp As String

Public Const MachineEpsilon = 5E-16
Public Const MaxRealNumber = 1E+300
Public Const MinRealNumber = 1E-300

Private Const BigNumber As Double = 1E+70
Private Const SmallNumber As Double = 1E-70
Private Const PiNumber As Double = 3.14159265358979

Public Function FormatInteger(I As Long, W As Long) As String
Dim Tmp As String
    If W <= 1 Then
        FormatInteger = Format(I, "0")
    Else
        Tmp = Format(I, String(W - 1, "#") & "0")
        Do While Len(Tmp) < W
            Tmp = " " & Tmp
        Loop
        FormatInteger = Tmp
    End If
End Function

Public Function FormatFReal(R As Double, W As Long, P As Long) As String
Dim Tmp As String
    Tmp = Format(R, "0." & String(P, "0"))
    Do While Len(Tmp) < W
        Tmp = " " & Tmp
    Loop
    FormatFReal = Tmp
End Function

Public Function FormatEReal(R As Double, W As Long, P As Long) As String
Dim Tmp As String
    Tmp = Format(R, "0." & String(P, "0") & "E+0")
    Do While Len(Tmp) < W
        Tmp = " " & Tmp
    Loop
    FormatEReal = Tmp
End Function

Public Sub ConsoleOutputString(S As String)
End Sub

Public Function MaxReal(ByVal M1 As Double, ByVal M2 As Double) As Double
    If M1 > M2 Then
        MaxReal = M1
    Else
        MaxReal = M2
    End If
End Function

Public Function MinReal(ByVal M1 As Double, ByVal M2 As Double) As Double
    If M1 < M2 Then
        MinReal = M1
    Else
        MinReal = M2
    End If
End Function

Public Function MaxInt(ByVal M1 As Long, ByVal M2 As Long) As Long
    If M1 > M2 Then
        MaxInt = M1
    Else
        MaxInt = M2
    End If
End Function

Public Function MinInt(ByVal M1 As Long, ByVal M2 As Long) As Long
    If M1 < M2 Then
        MinInt = M1
    Else
        MinInt = M2
    End If
End Function

Public Function ArcSin(ByVal X As Double) As Double
    Dim T As Double
    T = Sqr(1 - X * X)
    If T < SmallNumber Then
        ArcSin = Atn(BigNumber * Sgn(X))
    Else
        ArcSin = Atn(X / T)
    End If
End Function

Public Function ArcCos(ByVal X As Double) As Double
    Dim T As Double
    T = Sqr(1 - X * X)
    If T < SmallNumber Then
        ArcCos = Atn(BigNumber * Sgn(-X)) + 2 * Atn(1)
    Else
        ArcCos = Atn(-X / T) + 2 * Atn(1)
    End If
End Function

Public Function SinH(ByVal X As Double) As Double
    SinH = (Exp(X) - Exp(-X)) / 2
End Function

Public Function CosH(ByVal X As Double) As Double
    CosH = (Exp(X) + Exp(-X)) / 2
End Function

Public Function TanH(ByVal X As Double) As Double
    Dim T As Double
    If X > 0 Then
        T = Exp(-X)
        T = T * T
        TanH = (1 - T) / (1 + T)
    Else
        T = Exp(X)
        T = T * T
        TanH = (T - 1) / (T + 1)
    End If
End Function

Public Function Pi() As Double
    'Pi = PiNumber
    Pi = ArcCos(-1)
End Function

Public Function Power(ByVal Base As Double, ByVal Exponent As Double) As Double
    Power = Base ^ Exponent
End Function

Public Function Square(ByVal X As Double) As Double
    Square = X * X
End Function

Public Function Log10(ByVal X As Double) As Double
    Log10 = Log(X) / Log(10)
End Function

Public Function Ceil(ByVal X As Double) As Double
    Ceil = -Int(-X)
End Function

Public Function RandomInteger(ByVal X As Long) As Long
    RandomInteger = Int(Rnd() * X)
End Function

Public Function Atn2(ByVal Y As Double, ByVal X As Double) As Double
    If SmallNumber * Abs(Y) < Abs(X) Then
        If X < 0 Then
            If Y = 0 Then
                Atn2 = Pi()
            Else
                Atn2 = Atn(Y / X) + Pi() * Sgn(Y)
            End If
        Else
            Atn2 = Atn(Y / X)
        End If
    Else
        Atn2 = Sgn(Y) * Pi() / 2
    End If
End Function

Public Function C_Complex(ByVal X As Double) As Complex
    Dim Result As Complex

    Result.X = X
    Result.Y = 0

    C_Complex = Result
End Function


Public Function AbsComplex(ByRef Z As Complex) As Double
    Dim Result As Double
    Dim W As Double
    Dim XABS As Double
    Dim YABS As Double
    Dim V As Double

    XABS = Abs(Z.X)
    YABS = Abs(Z.Y)
    W = MaxReal(XABS, YABS)
    V = MinReal(XABS, YABS)
    If V = 0 Then
        Result = W
    Else
        Result = W * Sqr(1 + Square(V / W))
    End If

    AbsComplex = Result
End Function


Public Function C_Opposite(ByRef Z As Complex) As Complex
    Dim Result As Complex

    Result.X = -Z.X
    Result.Y = -Z.Y

    C_Opposite = Result
End Function


Public Function Conj(ByRef Z As Complex) As Complex
    Dim Result As Complex

    Result.X = Z.X
    Result.Y = -Z.Y

    Conj = Result
End Function


Public Function CSqr(ByRef Z As Complex) As Complex
    Dim Result As Complex

    Result.X = Square(Z.X) - Square(Z.Y)
    Result.Y = 2 * Z.X * Z.Y

    CSqr = Result
End Function


Public Function C_Add(ByRef Z1 As Complex, ByRef Z2 As Complex) As Complex
    Dim Result As Complex

    Result.X = Z1.X + Z2.X
    Result.Y = Z1.Y + Z2.Y

    C_Add = Result
End Function


Public Function C_Mul(ByRef Z1 As Complex, ByRef Z2 As Complex) As Complex
    Dim Result As Complex

    Result.X = Z1.X * Z2.X - Z1.Y * Z2.Y
    Result.Y = Z1.X * Z2.Y + Z1.Y * Z2.X

    C_Mul = Result
End Function


Public Function C_AddR(ByRef Z1 As Complex, ByVal R As Double) As Complex
    Dim Result As Complex

    Result.X = Z1.X + R
    Result.Y = Z1.Y

    C_AddR = Result
End Function


Public Function C_MulR(ByRef Z1 As Complex, ByVal R As Double) As Complex
    Dim Result As Complex

    Result.X = Z1.X * R
    Result.Y = Z1.Y * R

    C_MulR = Result
End Function


Public Function C_Sub(ByRef Z1 As Complex, ByRef Z2 As Complex) As Complex
    Dim Result As Complex

    Result.X = Z1.X - Z2.X
    Result.Y = Z1.Y - Z2.Y

    C_Sub = Result
End Function


Public Function C_SubR(ByRef Z1 As Complex, ByVal R As Double) As Complex
    Dim Result As Complex

    Result.X = Z1.X - R
    Result.Y = Z1.Y

    C_SubR = Result
End Function


Public Function C_RSub(ByVal R As Double, ByRef Z1 As Complex) As Complex
    Dim Result As Complex

    Result.X = R - Z1.X
    Result.Y = -Z1.Y

    C_RSub = Result
End Function


Public Function C_Div(ByRef Z1 As Complex, ByRef Z2 As Complex) As Complex
    Dim Result As Complex
    Dim A As Double
    Dim b As Double
    Dim C As Double
    Dim D As Double
    Dim E As Double
    Dim F As Double

    A = Z1.X
    b = Z1.Y
    C = Z2.X
    D = Z2.Y
    If Abs(D) < Abs(C) Then
        E = D / C
        F = C + D * E
        Result.X = (A + b * E) / F
        Result.Y = (b - A * E) / F
    Else
        E = C / D
        F = D + C * E
        Result.X = (b + A * E) / F
        Result.Y = (-A + b * E) / F
    End If

    C_Div = Result
End Function


Public Function C_DivR(ByRef Z1 As Complex, ByVal R As Double) As Complex
    Dim Result As Complex

    Result.X = Z1.X / R
    Result.Y = Z1.Y / R

    C_DivR = Result
End Function


Public Function C_RDiv(ByVal R As Double, ByRef Z2 As Complex) As Complex
    Dim Result As Complex
    Dim A As Double
    Dim C As Double
    Dim D As Double
    Dim E As Double
    Dim F As Double

    A = R
    C = Z2.X
    D = Z2.Y
    If Abs(D) < Abs(C) Then
        E = D / C
        F = C + D * E
        Result.X = A / F
        Result.Y = -(A * E / F)
    Else
        E = C / D
        F = D + C * E
        Result.X = A * E / F
        Result.Y = -(A / F)
    End If

    C_RDiv = Result
End Function


Public Function C_Equal(ByRef Z1 As Complex, ByRef Z2 As Complex) As Boolean
    Dim Result As Boolean

    Result = Z1.X = Z2.X And Z1.Y = Z2.Y

    C_Equal = Result
End Function


Public Function C_NotEqual(ByRef Z1 As Complex, _
         ByRef Z2 As Complex) As Boolean
    Dim Result As Boolean

    Result = Z1.X <> Z2.X Or Z1.Y <> Z2.Y

    C_NotEqual = Result
End Function

Public Function C_EqualR(ByRef Z1 As Complex, ByVal R As Double) As Boolean
    Dim Result As Boolean

    Result = Z1.X = R And Z1.Y = 0

    C_EqualR = Result
End Function


Public Function C_NotEqualR(ByRef Z1 As Complex, _
         ByVal R As Double) As Boolean
    Dim Result As Boolean

    Result = Z1.X <> R Or Z1.Y <> 0

    C_NotEqualR = Result
End Function


Public Function SplitTrim(ByVal S As String, ByVal SEP As String) As String()
    Dim SPrev As String
    S = Trim(S)
    Do
        SPrev = S
        S = Replace(S, "  ", " ")
    Loop Until S = SPrev
    SplitTrim = Split(S, SEP)
End Function

Public Function OpenDataset(ByVal FileName As String, ByRef DS As ALGLIBDataset) As Boolean
Dim FileNumber As Long, LinesRead As Long, TextLine As String, HeadArr As Variant, RowsArr As Variant, ColsArr As Variant
Dim VarsArr As Variant, Tmpc As Long, RowIndex As Long, I As Long
Dim TrnFirst As Long, ValFirst As Long, TrnLast As Long, ValLast As Long, TstFirst As Long, TstLast As Long
    DS.NClasses = 0
    DS.NIn = 0
    DS.NOut = 0
    DS.TotalSize = 0
    DS.TrnSize = 0
    DS.TstSize = 0
    DS.ValSize = 0
    
    FileNumber = FreeFile()
    LinesRead = 0
    On Error GoTo HandleNoFile
    Open FileName For Input As FileNumber
    On Error GoTo HandleErrorWithinFile
    Do While Not EOF(FileNumber)
        Line Input #FileNumber, TextLine
        If (Left(TextLine, 2) <> "//") And (Trim(TextLine) <> "") Then
            If LinesRead = 0 Then
                '
                ' read header
                '
                HeadArr = SplitTrim(TextLine, "#")
                If UBound(HeadArr) <> 1 Then Error 1
                
                '
                ' rows information
                '
                RowsArr = SplitTrim(HeadArr(0), " ")
                If (UBound(RowsArr) < 0) Or (UBound(RowsArr) > 2) Then Error 1
                If UBound(RowsArr) = 0 Then
                    DS.TotalSize = Val(RowsArr(0))
                    DS.TrnSize = DS.TotalSize
                End If
                If UBound(RowsArr) = 1 Then
                    DS.TrnSize = Val(RowsArr(0))
                    DS.TstSize = Val(RowsArr(1))
                    DS.TotalSize = DS.TrnSize + DS.TstSize
                End If
                If UBound(RowsArr) = 2 Then
                    DS.TrnSize = Val(RowsArr(0))
                    DS.ValSize = Val(RowsArr(1))
                    DS.TstSize = Val(RowsArr(2))
                    DS.TotalSize = DS.TrnSize + DS.ValSize + DS.TstSize
                End If
                If DS.TotalSize <= 0 Or DS.TrnSize < 0 Or DS.ValSize < 0 Or DS.TstSize < 0 Then Error 1
                TrnFirst = 0
                TrnLast = TrnFirst + DS.TrnSize
                ValFirst = TrnLast
                ValLast = ValFirst + DS.ValSize
                TstFirst = ValLast
                TstLast = TstFirst + DS.TstSize
                
                '
                ' columns
                '
                ColsArr = SplitTrim(HeadArr(1), " ")
                If (UBound(ColsArr) <> 0) And (UBound(ColsArr) <> 3) Then Error 1
                If UBound(ColsArr) = 0 Then
                    DS.NIn = Val(ColsArr(0))
                    If DS.NIn <= 0 Then Error 1
                End If
                If UBound(ColsArr) = 3 Then
                    If (LCase(ColsArr(0)) <> "reg") And (LCase(ColsArr(0)) <> "cls") Then Error 1
                    If ColsArr(2) <> "=>" Then Error 1
                    DS.NIn = Val(ColsArr(1))
                    If DS.NIn < 1 Then Error 1
                    If LCase(ColsArr(0)) = "reg" Then
                        DS.NClasses = 0
                        DS.NOut = Val(ColsArr(3))
                        If DS.NOut < 1 Then Error 1
                    Else
                        DS.NClasses = Val(ColsArr(3))
                        DS.NOut = 1
                        If DS.NClasses < 2 Then Error 1
                    End If
                End If
                
                '
                ' initialize arrays
                '
                ReDim DS.AllDataset(0 To DS.TotalSize - 1, 0 To DS.NIn + DS.NOut - 1)
                If DS.TrnSize > 0 Then ReDim DS.Trn(0 To DS.TrnSize - 1, 0 To DS.NIn + DS.NOut - 1)
                If DS.ValSize > 0 Then ReDim DS.Val(0 To DS.ValSize - 1, 0 To DS.NIn + DS.NOut - 1)
                If DS.TstSize > 0 Then ReDim DS.TST(0 To DS.TstSize - 1, 0 To DS.NIn + DS.NOut - 1)
            Else
                '
                ' read data
                '
                VarsArr = SplitTrim(TextLine, " ")
                If UBound(VarsArr) <> DS.NIn + DS.NOut - 1 Then Error 1
                Tmpc = Round(VarsArr(DS.NIn + DS.NOut - 1))
                If (DS.NClasses > 0) And ((Tmpc < 0) Or (Tmpc >= DS.NClasses)) Then Error 1
                RowIndex = LinesRead - 1
                For I = 0 To DS.NIn + DS.NOut - 1 Step 1
                    DS.AllDataset(RowIndex, I) = VarsArr(I)
                    If RowIndex >= TrnFirst And RowIndex < TrnLast Then
                        DS.Trn(RowIndex - TrnFirst, I) = VarsArr(I)
                    End If
                    If RowIndex >= ValFirst And RowIndex < ValLast Then
                        DS.Val(RowIndex - ValFirst, I) = VarsArr(I)
                    End If
                    If RowIndex >= TstFirst And RowIndex < TstLast Then
                        DS.TST(RowIndex - TstFirst, I) = VarsArr(I)
                    End If
                Next I
            End If
            LinesRead = LinesRead + 1
        End If
    Loop
    Close FileNumber
    OpenDataset = True
    Exit Function
HandleNoFile:
    OpenDataset = False
    Exit Function
HandleErrorWithinFile:
    Close FileNumber
    OpenDataset = False
    Exit Function
End Function