basTgAlgorithm.bas

Attribute VB_Name = "basTgAlgorithm"
Public Type typeTgStat
    Name As String
End Type
Public Type typeTgTelemetry
    Stat() As Double
End Type
Public Type typeTgItem
    Name As String
    Stat() As Double
    Link() As Double
End Type
Public Type typeTgData
    StatFile As String
    ItemFile As String
    LinkFile As String
    StatCount As Long
    ItemCount As Long
    Stat() As typeTgStat
    Item() As typeTgItem
    Telemetry(1 To 4) As typeTgTelemetry
    PTotal As Double
    PCount As Double
End Type
Sub redimdata(Tgdata As typeTgData)

    Tgdata.PCount = 0
    Tgdata.PTotal = 4 + Tgdata.ItemCount + 1

    'frmTgProgress.Show
    'frmTgProgress.Caption = "Allocating Memory"
    'frmTgProgress.Refresh

    ReDim Tgdata.Stat(0 To Tgdata.StatCount)
    For t = 1 To 4
        ReDim Tgdata.Telemetry(t).Stat(0 To Tgdata.StatCount)
        pdisp Tgdata
    Next t
    ReDim Tgdata.Item(0 To Tgdata.ItemCount)
    For t = 0 To Tgdata.ItemCount
        ReDim Tgdata.Item(t).Stat(0 To Tgdata.StatCount)
        ReDim Tgdata.Item(t).Link(0 To Tgdata.ItemCount)
        pdisp Tgdata
    Next t

    'frmTgProgress.Hide

End Sub
Sub loaddata(Tgdata As typeTgData)

    Open Tgdata.StatFile For Input As 1
    Open Tgdata.ItemFile For Input As 2
    Input #1, tmpstr, Tgdata.StatCount
    Input #2, tmpstr, Tgdata.ItemCount

    redimdata Tgdata

    resetptotal Tgdata
    CIncr Tgdata.PTotal, Tgdata.ItemCount + Tgdata.StatCount

    Input #1, tmpstr
    Input #2, tmpstr

    For t = 1 To StatCount
        Input #1, tmp, Tgdata.Stat(t).Name
        pdisp Tgdata
    Next t

    For t = 1 To ItemCount
        Input #2, tmp, Tgdata.Item(t).Name
        pdisp Tgdata
    Next t

    Input #1, tmpstr
    Input #2, tmpstr

    Close 1
    Close 2
End Sub
Sub resetptotal(Tgdata As typeTgData)

    Tgdata.PCount = 0
    Tgdata.PTotal = Tgdata.ItemCount * (Tgdata.StatCount + (Tgdata.StatCount + (Tgdata.ItemCount - 1) * (Tgdata.StatCount + (Tgdata.ItemCount - 2#) * 2# * Tgdata.StatCount)))

End Sub
Sub algorithm(Tgdata As typeTgData)

    'frmTgProgress.Show
    'frmTgProgress.Caption = "Taktikosgenesis"
    'frmTgProgress.Refresh

    'resetptotal Tgdata

    For t = 1 To Tgdata.ItemCount
        For tt = 1 To Tgdata.StatCount
            Tgdata.Telemetry(1).Stat(tt) = Tgdata.Item(t).Stat(tt)
            pdisp Tgdata
        Next tt
        For t2 = 1 To Tgdata.ItemCount
            If t2 <> t Then
                telradius = 0
                For tt = 1 To Tgdata.StatCount
                    Tgdata.Telemetry(2).Stat(tt) = Tgdata.Item(t2).Stat(tt)
                    CIncr telradius, (Tgdata.Item(t).Stat(tt) - Tgdata.Item(t2).Stat(tt)) ^ 2
                    pdisp Tgdata
                Next tt
                For t3 = 1 To Tgdata.ItemCount
                    If t3 <> t1 And t3 <> t2 Then
                        For ttel = 1 To 2
                            telspan = 0
                            For tt = 1 To Tgdata.StatCount
                                CIncr telspan, (Tgdata.Telemetry(ttel).Stat(tt) - Tgdata.Item(t3).Stat(tt)) ^ 2
                                pdisp Tgdata
                            Next tt
                            If telspan > telradius Then
                                CIncr Tgdata.Item(t).Link(t2), 1
                            End If
                        Next ttel
                    End If
                Next t3
            End If
        Next t2
    Next t
    'frmTgProgress.Hide

End Sub
Sub dumpdata(Tgdata As typeTgData)

    Open Tgdata.LinkFile For Output As 1
    For t = 1 To Tgdata.ItemCount
        Print #1, "item(" & t & "):" & Tgdata.Item(t).Name
        Print #1, "{"
        Print #1, "statistics:"
        For t2 = 1 To Tgdata.StatCount
            Print #1, Tgdata.Stat(t2).Name & ":" & Tgdata.Item(t).Stat(t2)
        Next t2
        Print #1, "classification:"
        For t2 = 1 To Tgdata.ItemCount
            If t2 <> t Then
                Print #1, "#" & t2 & "(" & Tgdata.Item(t2).Name & "):" & Fix(Tgdata.Item(t).Link(t2) / ((Tgdata.ItemCount - 2) * 2) * 100) & "%"
            End If
        Next t2
        Print #1, "}"
    Next t
    Close 1

End Sub

Sub pdisp(Tgdata As typeTgData)
    'Tgdata.PCount = Tgdata.PCount + 1
    'If (Fix((Tgdata.PCount / Tgdata.PTotal) * 100) & "%") <> frmTgProgress.lblp(0).Caption Then
    '    frmTgProgress.lblp(0).Caption = Fix((Tgdata.PCount / Tgdata.PTotal) * 100) & "%"
    '    frmTgProgress.lblp(1).Caption = Tgdata.PCount & " of " & Tgdata.PTotal
    '    frmTgProgress.Refresh
    'End If
End Sub