Contents in this wiki are for entertainment purposes only
This is not fiction ∞ this is psience of mind

QAT Code: Whse Class

From Catcliffe Development
Revision as of 11:43, 14 July 2023 by XenoEngineer (talk | contribs) (Created page with "{{headerQuasiAI|subcat=QAT.code}} {{headerQATcode| —Warehouse Class Code}} Category:QAT.clsWhse <div style="background:azure; border:1px outset azure; margin:1em 2em; padding:0 1em; width:888px;"> Option Explicit ' Forces variable declaration in the compile. ' Publicly visible 'Events' raised to callback-functions from within this class. Public Event CommandResponse(ByVal Message As String) ' In-class functions communicate functional-process outcome to...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

quasiArtifactualIntelligence —a perception from the edge

  About White paper QuasiMatrix Code QAT Code Data Examples Scatter-Gather Explained The Plow Share

The QAT Code —Warehouse Class Code

The Warehouse if Pairs Expansion then Visual Scatter else Visual Cluster redim Bracketing Clusters while Event Chemistry wend SLIP class redim

Option Explicit ' Forces variable declaration in the compile.

' Publicly visible 'Events' raised to callback-functions from within this class. Public Event CommandResponse(ByVal Message As String) ' In-class functions communicate functional-process outcome to interface-code for interface-updates. Public Event DataLoaded(ByRef oFile As clsFile) ' This class instance will call the 'DataLoaded' form module 'event code'. Public Event ConjectureChanged(ByVal ConjColumnAtom As Long, ByVal ConjColumnLink As Long)

Public Event AtomsExtracted() Public Event MartPulled() Public Event PairsExported() Public Event WarehouseUnloaded()

Public Event Progress(ByRef msg As String)

' Properties Private mstrDataFile As String Private mlngDataRowCount As Long Private mlngDataHeaderRowIndex As Long ' An index pointing within a zero-based array to a data row with column-header captions. Private mstrDataRowDelimiter As String Private mstrDataColumnDelimiter As String

Private mlngConjAtomColumn As Long Private mlngConjLinkColumn As Long

Private mbooCancel As Boolean ' Checked in long iterations: Combinatoric generation per Atom-Link conjecture match.

' Class state (code in this class that toggles these state variables also raise an 'event'). Private mbooDataLoaded As Boolean Private mbooConjValid As Boolean Private mbooMartPulled As Boolean Private mbooAtomsExtracted As Boolean Private mbooLinksExtracted As Boolean Private mbooPairsExported As Boolean

' Class data arrays Private mstrDataArray() As String ' array of data rows Private mstrDataHeaderRow() As String ' array of data header-row fields (1st row from file) Private mstrMartArray() As String ' array column data selected by Conjecture options

' Processed data arrays Private mstrPairsArray() As String ' Atom pairs of ColA sharing Links Private mstrLinksArray() As String ' Links of ColB per Atom

Private mcolAtoms() As String ' Hash array of VB String values as a Microsoft VB 6 keyed-collection object.

Private Sub Class_Initialize()

   On Error Resume Next

End Sub

Private Sub Class_Terminate()

   On Error Resume Next

End Sub


Public Function Combinatorics(ByVal TabularString As String) As String()

   '   Return a string array loaded with all the combinations of SecNames
   '   in TabularString, ignoring the first tabular string entry, which is an Atom FirstName
   Dim maxName             As Long
   Dim maxNdx              As Long
   Dim moduloNdx           As Long
   Dim strCombinations()   As String 'array
   Dim strNames()          As String 'array
   Dim ndxCombination      As Long
   Dim j, k, intLast       As Integer
   
   On Error Resume Next
   
   '   TabularString format (Paired)
   '   FirName Tab SecName1 Tab SecName2 Tab SecName3...
   
   With New clsStopWatch
       .Reset
       
       TrimTrailingCharacters TabularString, vbTab
       
       strNames = Split(TabularString, vbTab)
       'Note: the first array element is a firstName, not to be combined
       
       maxName = UBound(strNames)
       maxNdx = maxName
       
       If maxName > 1 Then '  0,1 and 2 elements -- 0= FirName; 1,2= Secnames
          
           '   Redim to something larger than typically expected
           '   Redim again later to size used after loading array
           ReDim strCombinations(maxName * maxName)
           
           'Debug.Print vbCrLf & "Combining FirName: " & strNames(0)
           
           If mbooCancel Then Exit Function
                                                        
           If maxName > 1 Then '   very key factor
               '   Key factor: if maxName is larger than two (larger than 1 for zero-based array elements)
               '               then at least a pair of mart rows matching columns A-Names
               '               are sharing a B-Name
               For k = 1 To maxName - 1    ' Start with element 1 of the zero-based strNames() array.
                   DoEvents
                                       
                   For j = 1 To (maxName - k)
                       '   Check array size and redim if more elements are needed
                       If ndxCombination > maxNdx Then
                           maxNdx = maxNdx + 1000
                           ReDim Preserve strCombinations(maxNdx)
                           'Debug.Print "maxNdx: " & maxNdx
                       End If
                       
                       '   Add the combination to the output array
                       strCombinations(ndxCombination) = strNames(k) & "**" & strNames(k + j)
                                                                       
                       'Debug.Print "(" & CStr(k) & ")-(" & CStr(k + j) & ") = " & strCombinations(ndxCombination)
                       ndxCombination = ndxCombination + 1
                       If moduloNdx Mod 5 = 0 Then
                           RaiseEvent Progress("Expanding combinatorics: " & CStr(moduloNdx))
                           DoEvents
                           If mbooCancel Then Exit Function
                       End If
                   Next
                   moduloNdx = moduloNdx + 1
               Next
               
               '   Redim the combinations array to the size used
               ReDim Preserve strCombinations(ndxCombination - 1)
               
               '   Return the array
               Combinatorics = strCombinations
               
           End If 'maxName
       Else
           'Debug.Print vbCrLf & "Skipping"
       End If
   End With 'New clsStopWatch
   

End Function

Public Function EnumeratedColumnNames(HeaderArray As Variant) As String

   Dim ndx, maxNdx As Integer
   Dim duplicateArray() As String 'array
   'todo: work this out better
   If Not IsArray(HeaderArray) Then Exit Function
   maxNdx = UBound(HeaderArray)
   
   ReDim duplicateArray(maxNdx)
   
   For ndx = 0 To maxNdx
       duplicateArray(ndx) = CStr(ndx) & vbTab & HeaderArray(ndx)
   Next
   '   Return a string transform of array
   '   elements delimited by CRLF
   EnumeratedColumnNames = Join(duplicateArray, vbCrLf)
   

End Function

Public Sub QuickSortVariants( _

           vArray As Variant, _
           inLow As Long, _
           inHi As Long, _
           ByRef ndx As Long, _
           ByRef maxNdx As Long)
     
   Dim pivot   As Variant
   Dim tmpSwap As Variant
   Dim tmpLow  As Long
   Dim tmpHi   As Long
       
   tmpLow = inLow
   tmpHi = inHi
   
   '   Increment completion counter
   ndx = ndx + 1
   
   pivot = vArray((inLow + inHi) \ 2)
   
   Me.Cancel = False
   
   While (tmpLow <= tmpHi) And Not Me.Cancel
 
       While (vArray(tmpLow) < pivot And tmpLow < inHi)
           tmpLow = tmpLow + 1
       Wend
     
       While (pivot < vArray(tmpHi) And tmpHi > inLow)
           tmpHi = tmpHi - 1
       Wend
       If (tmpLow <= tmpHi) Then
           tmpSwap = vArray(tmpLow)
           vArray(tmpLow) = vArray(tmpHi)
           vArray(tmpHi) = tmpSwap
           tmpLow = tmpLow + 1
           tmpHi = tmpHi - 1
           If ndx Mod 100 = 0 Then
               RaiseEvent Progress("Sort percentage remaining: " & CStr(CInt((1 - (ndx / maxNdx)) * 10000) / 100))
               DoEvents
           End If
       End If
  
   Wend
   
   
   If (inLow < tmpHi) Then QuickSortVariants vArray, inLow, tmpHi, ndx, maxNdx
   If (tmpLow < inHi) Then QuickSortVariants vArray, tmpLow, inHi, ndx, maxNdx
 

End Sub

Public Property Get LinkCount() As Long

   On Error Resume Next
   
   LinkCount = UBound(mstrLinksArray)

End Property


Public Function ConjectureCreate( _

           ByVal AtomColumn As Long, _
           ByVal LinkColumn As Long _
           ) As Boolean
           
   ' Return True if columns are in range, and not equal.
   ' Quietly persist columns set to the INI file.
   
   Dim MaxColumn As Integer
   Dim x() As String
   
   On Error Resume Next
   
   If Not Me.DataLoaded Then
       RaiseEvent CommandResponse("Conjecture column cannot be set until the Data is loaded.")
   Else
       MaxColumn = UBound(Split(mstrDataArray(0), vbTab)) ' Zero-based array split on the first row in the whse data.
       
       '   Validate input (false case)
       Select Case False
           Case (AtomColumn >= 0)
           Case (AtomColumn <= MaxColumn)
           Case (LinkColumn >= 0)
           Case (LinkColumn <= MaxColumn)
           Case (LinkColumn <> AtomColumn)
           Case Else
               '   Proceed with validated inputs.
               '   Store the column indexes.
               mbooConjValid = True
               
               mlngConjAtomColumn = AtomColumn
               mlngConjLinkColumn = LinkColumn
               
               ' Save the conjecture columns.
               INIWrite "Preferences", "ConjAtomColumnIndex", mlngConjAtomColumn
               INIWrite "Preferences", "ConjLinkColumnIndex", mlngConjLinkColumn
               
       End Select
   End If 'me.DataLoaded

End Function


'public Function iFnData_ExtractAtoms(Optional ByVal TopicName As String = "A1") As Boolean ' Dim ndx As Long ' Dim lngCount As Long ' Dim strSplitPairs() As String 'array ' ' Dim lngLength As Long ' Dim strAtom As String ' Dim strPairs As String ' Dim intExtractions As Integer ' ' On Error Resume Next ' ' Screen.MousePointer = vbHourglass ' ' RaiseEvent CommandResponse("Extracting unique members from Paired.txt...") ' ' ' ' Flatten the inner and outer delimiters to the same (Replace "**" with CRLF ) ' strPairs = Replace(strPairs, "**", vbCrLf) ' ' ' Split the delimited members to an array ' strSplitPairs = Split(strPairs, vbCrLf) ' ' ' Loop through array, checking for new Members from Pairs ' lngCount = UBound(strSplitPairs) ' For ndx = 0 To lngCount ' ' Test that the array element is in the Atoms buffer If InStr(1, mstrAtomsStringBuffer, strSplitPairs(ndx)) = 0 Then 'not there ' Concatenate the new randomized atom to the buffer at the beginning mstrAtomsStringBuffer = strSplitPairs(ndx) & vbTab & CStr(Int(Rnd * 360) + 1) & vbCrLf & mstrAtomsStringBuffer intExtractions = intExtractions + 1 End If ' Next ' ' ' Remove the trailing delimiter ' 'mstrAtomsStringBuffer = Left$(mstrAtomsStringBuffer, Len(mstrAtomsStringBuffer) - 1) ' ' ' The reduced set of Pairs is now a unique set of delimited Atoms in mstrAtomsStringBuffer. ' ' ' Write the fresh Members data to file as the Members of the top Topic named ' ' the value in 'TopicName' in a folder named by the value in 'TopicName' ' With New clsFile ' ' ' Create a new top distribution if non-existant, ' ' or query the user for overwrite permission, ' ' else bail, no persistence -- no existence ' Select Case .FileExists(mstrDataPath & "\" & TopicName & "\Members.txt") ' ' Case True ' ' If MsgBox("Overwrite the Members.txt file for Topic " & TopicName & "?", vbYesNo + vbQuestion + vbDefaultButton2, "Random distribution available") = vbYes Then ' If .Save(mstrAtomsStringBuffer, UseAppend:=False) Then ' ' Create (or err past if existing) a folder for the top node, named A1 ' iFnData_ExtractAtoms = True ' Else ' RaiseEvent CommandResponse("Unable to save the Atoms extracted from Paired.txt to " & .Filespec) ' MsgBox "Unable to save the Atoms extracted from Paired.txt to: " & .Filespec ' End If ' End If ' ' Case False ' ' ' Create the new Topic Folder ' MkDir Root.DataPath & "\" & TopicName ' ' ' If .Save(mstrAtomsStringBuffer) Then ' RaiseEvent CommandResponse("Extracted Atoms saved to " & .Filespec) ' iFnData_ExtractAtoms = True ' Else ' RaiseEvent CommandResponse("Unable to save the Atoms extracted from Paired.txt to: " & .Filespec) ' MsgBox "Unable to save the Atoms extracted from Paired.txt to: " & .Filespec ' End If ' ' End Select ' End With ' ' RaiseEvent CommandResponse("Extraction of member atoms complete. " & CStr(intExtractions) & " members extracted.") ' ' Screen.MousePointer = vbDefault ' 'End Function

Public Function TrimTrailingCharacters(ByRef Source As String, ByVal Characters As String) As String

   '   Remove trailing characters passed by argument
   Do While StrComp(Right$(Source, Len(Characters)), Characters) = 0
       Source = Left$(Source, Len(Source) - Len(Characters))
   Loop
   
   TrimTrailingCharacters = Source

End Function

Public Function DataLoad(ByRef TabularString As String) As Boolean

   On Error GoTo Trap
   
   '   String passed by reference, avoiding memory copy.  The calling function destroys passed String.
   '   Remove any trailing row-delimiters while looping.
   Do While StrComp(Right$(TabularString, 2), vbCrLf) = 0
       '   Remove trailing row delimiters.
       TabularString = Left$(TabularString, Len(TabularString) - 2)
   Loop
   
   '   Split the input String into the Data row-array at the row delimiters.
   mstrDataArray = Split(TabularString, DataRowDelimiter)
   mlngDataRowCount = UBound(mstrDataArray)        '   Zero-based array index of the last data row read.
   
   mbooDataLoaded = CBool(UBound(mstrDataArray) > 0)   '   Loaded only if more than header record exists.
   
   '   Return outcome.
   DataLoad = mbooDataLoaded
   
   Exit Function

Trap:

   Select Case Err.number
       Case Else
           MsgBox "DataLoad() Failure: " & formatErrorMsg(Err.number, Err.description, Err.Source), vbExclamation + vbOKOnly, "I/O error"
   End Select

End Function

Public Property Get ConjAtomColumnIndex() As Long

   ConjAtomColumnIndex = mlngConjAtomColumn

End Property Public Property Let ConjAtomColumnIndex(ByVal Value As Long)

   mlngConjAtomColumn = Value

End Property

Public Property Get ConjLinkColumnIndex() As Long

   ConjLinkColumnIndex = mlngConjLinkColumn

End Property

Public Property Let ConjLinkColumnIndex(ByVal Value As Long)

   mlngConjLinkColumn = Value

End Property

Public Property Get ConjValid() As Boolean

   ConjValid = mbooConjValid

End Property

Public Property Get DataRowCount() As Long

   On Error Resume Next
   
   If mbooDataLoaded Then DataRowCount = UBound(mstrDataArray) - mlngDataHeaderRowIndex + 1 ' Zero-based data array.

End Property

Public Function FieldValue(ByVal Row As Long, ByVal Column As Long) As String

   On Error Resume Next
   
   FieldValue = Split(mstrDataArray(Row), DataColumnDelimiter)(Column)

End Function

Public Property Let DataColumnDelimiter(ByVal Value As String)

   mstrDataColumnDelimiter = Value

End Property Public Property Get DataColumnDelimiter() As String

   DataColumnDelimiter = mstrDataColumnDelimiter

End Property

Public Property Let DataRowDelimiter(ByVal Value As String)

   mstrDataRowDelimiter = Value

End Property Public Property Get DataRowDelimiter() As String

   DataRowDelimiter = mstrDataRowDelimiter

End Property

Public Function LoadWarehouse(Optional ByVal FileName As String) As Long

   On Error GoTo Trap
   ' FileName must be a useable filespec (path and filename).
   ' Return the Data row count on success.
   
   If Len(FileName) > 0 Then
       mstrDataFile = FileName            ' Save FileName passed.
       With New clsFile
           If .FileExists(FileName) Then
               If DataLoad(.ReadAll(mstrDataFile)) Then
                   LoadWarehouse = Me.DataRowCount  'at least 1 more row than header row qualifies as loaded
                   RaiseEvent DataLoaded(.Self)
               Else
                   RaiseEvent CommandResponse("Unable to load Warehouse data from " & mstrDataFile)
               End If
           Else
               MsgBox "Warehouse Data File Not Found: " & .Filespec, vbInformation
               RaiseEvent CommandResponse("File not found: " & .Filespec)
           End If
       End With
       
   End If
       
   Exit Function

Trap:

   Select Case Err.number
       Case Else
           MsgBox "LoadWarehouse: " & formatErrorMsg(Err.number, Err.description, Err.Source)
           Exit Function
           Resume ' debugging
   End Select

End Function

Public Property Get MaxColumn() As Integer

   On Error Resume Next
   
   If mbooDataLoaded Then
       MaxColumn = UBound(Split(mstrDataArray(0), vbTab))
   End If

End Property

Public Property Let Cancel(ByVal Value As Boolean)

   mbooCancel = Value

End Property

Public Property Get Cancel() As Boolean

   Cancel = mbooCancel

End Property

Public Function Clear() As Boolean

   On Error Resume Next
   
   ReDim mstrDataArray(0)
   ReDim mstrDataHeaderRow(0)
   
   ReDim mstrMartArray(0)
   ReDim mstrPairsArray(0)
   ReDim mstrLinksArray(0)
   
   
   Clear = CBool(Err.number)

End Function

Public Property Get MartCount() As Long

   On Error Resume Next
   
   If mbooMartPulled Then MartCount = UBound(mstrMartArray) + 1

End Property

' Enumerate all Warehouse records, pulling the ' combined conjecture columns into the Mart array. Public Function MartPull() As Boolean

   Dim ndx As Long
   Dim maxNdx As Long
   Dim strField() As String 'array
   Dim msg As String
   
   On Error Resume Next
   
   '   Store the max array index for enumeration
   maxNdx = UBound(mstrDataArray)
   
   '   Size the Mart array to the warehouse size
   ReDim mstrMartArray(maxNdx)
   
   '   Check for contextual validity
   If (mlngConjAtomColumn > -1) And (mlngConjLinkColumn > -1) Then
       '   Enumerate all Warehouse records, pulling the
       '   combined conjecture columns into the Mart array.
       
       For ndx = 0 To maxNdx 'including header at 0
           '   Split the record into strField array at the inner delimiter
           strField = Split(mstrDataArray(ndx), DataColumnDelimiter)
           
           '   Copy into the Mart array the two fields specified by conjecture
           mstrMartArray(ndx) = strField(mlngConjLinkColumn) & _
                               DataColumnDelimiter & _
                               strField(mlngConjAtomColumn)   ' B <Tab> A
       Next ndx
       
       '   Sort the new Mart array, now in natural order from Whse
       QuickSortVariants mstrMartArray, 1, UBound(mstrMartArray), 0, UBound(mstrMartArray)
       
       '   Join all array elements into a string with line delimiters streaming to file
       With New clsFile
           .Filespec = DataFolder & "\Mart.txt"
           
           '   Save the Mart in the data path as a
           '   Column/Line delimited tabulation of string data.
           
           If .Save(Join(SourceArray:=mstrMartArray, delimiter:=mstrDataRowDelimiter)) Then
               mbooMartPulled = True
               MartPull = True
               RaiseEvent CommandResponse("Mart columns pulled, and saved to file")
               RaiseEvent MartPulled
           Else
               msg = "Unable to save the Mart data to file " & .Filespec
           End If
       End With
       
   Else
       RaiseEvent CommandResponse("Mart cannot be Pulled until both conjectures are selected, i.e., A = 4 <CR> B = 5 <CR>")
   End If
                      

End Function

Public Property Get MartPulled() As Long

   MartPulled = mbooMartPulled

End Property

Public Function DataRowArray(ByVal Index As Long) As String()

   On Error Resume Next
   DataRowArray = Split(mstrDataArray(Index), DataColumnDelimiter)

End Function

Public Property Get DataColumnHeaders() As String()

   On Error Resume Next
   If mbooDataLoaded Then DataColumnHeaders = Split(mstrDataArray(0), mstrDataColumnDelimiter)

End Property

Public Property Get PairsCount() As Long

   On Error Resume Next
   If mbooPairsExported Then PairsCount = UBound(mstrPairsArray) + 1  'element zero contians column headers

End Property

Public Property Get PairsExported() As Long

   PairsExported = mbooPairsExported

End Property

Public Function PairsExport() As Boolean

   Dim oFile       As clsFile
   Dim ndx         As Long
   Dim strField()  As String 'array
   Dim colAtoms    As Collection
   Dim colLinks    As Collection
   Dim strPaired   As String
   Dim strJoin     As String
   Dim varX        As Variant
   
   '   Atom format (Paired)
   '   FirName Tab SecName1 Tab SecName2 Tab ... SecNameX
  
   On Error GoTo Trap
   
   mbooCancel = False
   
   Set colAtoms = New Collection
   Set colLinks = New Collection
       
   With New clsStopWatch
       If mbooMartPulled Then
           .Reset '   Start timer
           RaiseEvent Progress("Pairs Export beginning...")
           '   Enumerate through all Mart array row elements
           '   and construct the Atoms.
           For ndx = 1 To Me.MartCount - 1
               DoEvents 'allowing update of cancellation flag during loop
               If Not mbooCancel Then
                   '   Split the outer Mart-array row element into an inner field-array
                   strField() = Split(mstrMartArray(ndx), vbTab)
                                       
                   '   Add a new firName to colAtoms
                   MergeSecNameByFirName colAtoms, strField(0), strField(1)
                   
                   If ndx Mod 100 = 0 Then
                       RaiseEvent Progress("Assembling atoms: record " & CStr(ndx))
                   End If
               Else
                   Exit Function
               End If 'Not mbooCancelPairs
           Next
           
           '   Enumerate through all Mart array row elements
           '   and construct the Links.
           For ndx = 1 To Me.MartCount - 1
               DoEvents 'allowing update of cancellation flag during loop
               If Not mbooCancel Then
                   '   Split the outer Mart-array row element into an inner field-array
                   strField() = Split(mstrMartArray(ndx), vbTab)
                    
                   '   Add a new SecName to colLinks (notice the parameters are switched)
                   MergeSecNameByFirName colLinks, strField(1), strField(0)  '   sort when complete
                   If ndx Mod 100 = 0 Then RaiseEvent Progress("Assembling links: record " & CStr(ndx) & "+")
               Else
                   Exit Function
               End If 'Not mbooCancelPairs
           Next
           
           '   Output the Links as tabular data
           ndx = 0
           ReDim mstrLinksArray(colLinks.Count - 1)
           
           '   Copy the collection object
           '   into the module links array
           ndx = 0
           For Each varX In colLinks
               mstrLinksArray(ndx) = varX
               ndx = ndx + 1
           Next
           
           '   Sort the new Links array, purely for human-readability, as order is irrelavant.
           QuickSortVariants mstrLinksArray, 0, UBound(mstrLinksArray), 0, UBound(mstrLinksArray)
           
           '   Store the array as a CR delimited
           '   tabular file named Links.txt
           With New clsFile
               .Save Join(mstrLinksArray, vbCrLf), DataFolder & "\Links.txt"
           End With
           RaiseEvent CommandResponse(CStr(ndx) & " Link saved as tabular data to file " & DataFolder & "\Links.txt")
           
           '   Create the paired combinatorics
           
           '   Enumerate atomics, creating a tabulation
           '   by string-concatenation of any new combinatrics
           '   joined from the array returned by the
           '   transform method producing combinatorics.
           ndx = 0
           For Each varX In colAtoms
               strJoin = Join(Combinatorics(varX), vbCrLf)
               If Len(strJoin) Then
                   If Len(strPaired) = 0 Then
                       strPaired = strJoin
                   Else
                       strPaired = strPaired & vbCrLf & strJoin
                   End If
               End If
               If ndx Mod 10 = 0 Then RaiseEvent Progress("Combining atom " & CStr(ndx) & "...")
               ndx = ndx + 1
           Next
           
           '   Store the Pairs tabular string data as a string array
           mstrPairsArray = Split(strPaired, vbCrLf)
           
           '   Sort the new Pairs array
           QuickSortVariants mstrPairsArray, 0, UBound(mstrPairsArray), 0, UBound(mstrPairsArray)
           RaiseEvent CommandResponse("Pairs sorted")
           
           '   Transform the array, now sorted
           '    to a string for storage to file
           strPaired = Join(mstrPairsArray, vbCrLf)
           
           '   Save the Pairs array to file
           Set oFile = New clsFile
           oFile.Filespec = DataFolder & "\Paired.txt"
           If oFile.Save(Join(mstrPairsArray, vbCrLf)) Then
               
               mbooPairsExported = True
               PairsExport = mbooPairsExported
               RaiseEvent CommandResponse("Pairs saved as " & DataFolder & "\Paired.txt")
               
               RaiseEvent CommandResponse("Combinatoric-pairs Export complete (Process time: " & CStr(.Elapsed / 1000) & ")")
           
           End If
       Else 'mbooMartPulled
           RaiseEvent CommandResponse("Unable to Export combinatoric-pairs because the Mart Columns have not been pulled")
       End If 'mbooMartPulled
   End With 'New clsStopWatch
   
   Exit Function

ExitPoint:

   Set colAtoms = Nothing
   Set colLinks = Nothing

Exit Function

Trap:

   RaiseEvent CommandResponse("Error in clsWhse.PairsExport: " & Err.description)
   Resume ExitPoint
   Resume

End Function


Public Sub MergeSecNameByFirName( _

      ByVal col As Collection, _
      ByVal FirName As String, _
      ByVal SecName As String _
      )
   ' Note!  July 2023, twenty three years later...
   '        The first parameter 'ByVal' is ignored and the 'col' collection
   '        is passed by reference.  This never threw an error.
   '        The line should read:
   '           "ByRef col As Collection, _"
   '
   '   Build a unique collection of Firname record delimitations
   '   Append uniquely the secname into the Tab-delimited
   '   string value referenced by the collection member, keyed by Firname
   
   '   The collection members delimited format is follows:
   '   FirName Tab SecName1 Tab SecName2 Tab SecName3 ...
   
   Dim strElements As String
   
   On Error Resume Next
   
      
   'Add a new member keyed by FirName...
   col.Add FirName & vbTab & SecName, Key:=FirName
   
   'This errors if member already exists -used because VB Collection object has no 'exists' function.
         
   If Err.number = 457 Then
       '   Exists already, so concatentate SecName to existing SecNames if not already there
       strElements = col.Item(CStr(FirName))
       
       '   Append uniquely the secname to the secname delimitation
       If InStr(1, strElements, SecName) = 0 Then
           'secname is not already in strSecNames, so concatenate it
           strElements = Join(Array(strElements, SecName), vbTab)
           
           col.Remove FirName
           col.Add strElements, FirName
           
       End If
   End If
   

End Sub


Public Property Get AtomsExtracted() As Boolean

   AtomsExtracted = mbooAtomsExtracted

End Property

Public Property Get DataFile() As String

   DataFile = mstrDataFile

End Property Public Property Let DataFile(ByVal Value As String)

   mstrDataFile = Value

End Property

Public Property Get DataFolder() As String ' r/o

   DataFolder = FileFolder(mstrDataFile)

End Property

Public Property Get DataLoaded() As Boolean

   DataLoaded = mbooDataLoaded

End Property


Public Property Get DataHeaderRowIndex() As Long

   DataHeaderRowIndex = mlngDataHeaderRowIndex

End Property Public Property Let DataHeaderRowIndex(ByVal Value As Long)

   mlngDataHeaderRowIndex = Value

End Property