Attribute VB_Name = "Module8"
' Function Name: SortedFatherArray()
' Parameters Byval: numOfLoci
' Return type: Array
' Description: Sorts the fatherArray and tallys the minimum number of fathers, as well as
'              the number of offspring they sire.
Public Function SortedFatherArray(ByVal numOfLoci)
    ' [DECLARE VARIABLES]
    Dim previouslyTested() As Variant
    Dim count As Integer, counter As Integer, iterator As Integer
    Dim column As Integer, tally As Integer, testColumn As Integer
    Dim match As Boolean

    ' [INITIALISE VARAIBLES]
    tally = 0
    ' Re-size arrays based on previous knowledge.
    ReDim previouslyTested(1)
    ReDim sortedArray(UBound(fatherArray, 2), numOfLoci + 1)
      
    For testColumn = 1 To UBound(fatherArray, 2)    ' Iterates through the columns of the FatherArray.
        For counter = 1 To UBound(previouslyTested)     ' Detemines if a column in the FatherArray has already been tallied.
            If (testColumn = previouslyTested(counter)) Then
                GoTo Skip
            End If
        Next counter
    
        For column = 1 To UBound(fatherArray, 2)
            For iterator = 1 To numOfLoci   ' Iterates through the rows of FatherArray (which correspond to the number of loci sampled).
                If (fatherArray(iterator, testColumn) = fatherArray(iterator, column)) Then
                    match = True    ' match = true when the allele combinations of two columns (over all loci) are the same.
                Else
                    match = False
                    Exit For    ' Enables EzyMate to stop testing the current column and not increase the corresponding tally.
                End If
            Next iterator
            
            ' Increases the tally of a allele combination. Ie: the number of offspring sired by a single drone.
            If (match) Then
                tally = tally + 1
                previouslyTested(UBound(previouslyTested)) = column
                ReDim Preserve previouslyTested(UBound(previouslyTested) + 1)
            End If
        Next column
    
        ' Only adds the required father genotypes to the new array (to minimise space required and efficiency).
        For count = 1 To numOfLoci
            sortedArray(testColumn, count) = fatherArray(count, testColumn)
        Next count
        sortedArray(testColumn, numOfLoci + 1) = tally
        
        ' [RE-INITIALISE VARIABLES]
        tally = 0
Skip:
    Next testColumn
    
    ' Option that allows the user to auto-condense the results data.
    If (condense = vbYes) Then
        Call CondenseFathers(sortedArray, numOfLoci)
    End If
        
    SortedFatherArray = sortedArray
End Function
' Subroutine Name: CondenseFathers()
' Parameters Byval: numOfLoci
' Parameters by reference: sortedArray
' Description: Automatically condenses the output data set in order to minimise the potential number
'              of fathers.
Private Sub CondenseFathers(sortedArray, ByVal numOfLoci)
    ' [DECLARE VARIABLES]
    Dim column As Integer, iterator As Integer, testRow As Integer
    Dim containsEmptyCell As Boolean, match As Boolean
    Dim emptyCell As String
    
    ' [INITIALISE VARIABLES]
    emptyCell = ""
    containsEmptyCell = False
    
    ' Locates rows that contain dots (from the original data set).
    For testRow = 1 To UBound(sortedArray, 1)
        For column = 1 To numOfLoci
            If (sortedArray(testRow, numOfLoci + 1) <> emptyCell) Then
                If (sortedArray(testRow, column) = emptyCell) Then
                    containsEmptyCell = True
                End If
            End If
        Next column
        
        ' Once a row is found to contain an unknown paternal allele contribution, EzyMate atomatically
        ' matches those rows with known allele contributions and combines the results.
        If (containsEmptyCell) Then
            For iterator = 1 To UBound(sortedArray, 1)
                If (sortedArray(iterator, numOfLoci + 1) <> emptyCell) Then
                    If (iterator <> testRow) Then
                        ' Aims to match the columns of known values to the testRow cell values.
                        For column = 1 To numOfLoci
                            If ((sortedArray(testRow, column) = sortedArray(iterator, column)) Or (sortedArray(testRow, column) = emptyCell)) Then
                                match = True
                            Else
                                match = False
                                Exit For
                            End If
                        Next column

                        ' Edits the sortedArray by increases the tally values (where appropriate) and not printing the
                        ' rows with uncertain cell values. This is quicker than deleting and resizing the array for every
                        ' uncertain result.
                        If (match) Then
                            sortedArray(iterator, numOfLoci + 1) = (sortedArray(iterator, numOfLoci + 1) + sortedArray(testRow, numOfLoci + 1))
                            sortedArray(testRow, numOfLoci + 1) = emptyCell 'Therefore this row will not be printed in by PrintFathers()
                            Exit For
                        End If
                    End If
                End If
            Next iterator
        End If
        containsEmptyCell = False
    Next testRow
End Sub
' Subroutine Name: PrintFathers()
' Parameters Byval: SortedFatherArray, numOfLoci
' Description: Displays drone results in a new sheet.
Public Sub PrintFathers(ByVal SortedFatherArray, ByVal numOfLoci)
    ' [DECLARE VARIABLES]
    Dim count As Integer, counter As Integer, row As Integer, column As Integer
    Dim fatherColumn As Integer, fatherNum As Integer, total As Integer, tally As Integer
    Dim emptyCell As String, specialCase As String
    Dim lastColumn As Boolean
        
    ' [INITIALISE VARAIBLES]
    emptyCell = ""
    row = 6
    column = 3
    specialCase = "*"   ' Individual carries both maternal alleles at a locus.
    fatherColumn = 1     ' Specifies the column to print father numbers in. Ie: Column A.
    fatherNum = 1        ' Starting value for father number. Increases as more fathers are required.
    total = 0
    tally = 0
    lastColumn = False
    ReDim numOfOffspringPerFather(1) ' Re-dimensionalises array.
    
    ActiveSheet.Cells(row, column).Select
    For count = 1 To UBound(SortedFatherArray, 1)   ' Iterates through rows of array. Ie: each father.
        If (SortedFatherArray(count, numOfLoci + 1) <> emptyCell) Then      ' Determines whether or not a row is to be displayed on screen.
            ActiveSheet.Cells(row, fatherColumn).Value = "Father " & fatherNum ' Prints father number.
            For counter = 1 To (numOfLoci + 1)
                ActiveCell.HorizontalAlignment = xlCenter
                If (SortedFatherArray(count, counter) = emptyCell) Then
                    ActiveCell.Value = "?"      ' "?" is only displayed in the non auto-condensing version.
                ElseIf (SortedFatherArray(count, counter) = specialCase) Then
                    If (counter <= numOfLoci) Then
                        ActiveCell.Value = queenArray(counter, 1) & " / " & queenArray(counter, 2)  ' Displays maternal genotype.
                    End If
                Else
                    ActiveCell.Value = SortedFatherArray(count, counter)
                    If (counter = (numOfLoci + 1)) Then
                        tally = ActiveCell.Value
                        numOfOffspringPerFather(fatherNum) = tally
                        ReDim Preserve numOfOffspringPerFather(UBound(numOfOffspringPerFather) + 1)
                        total = total + tally       ' Corresponds to colony size.
                    End If
                End If
                ActiveCell.Offset(0, 2).Select
            Next counter
            row = row + 1
            fatherNum = fatherNum + 1
            ActiveSheet.Cells(row, column).Select
        End If
    Next count
    
    numOfFathers = fatherNum - 1      ' Stores the number of drones.
    
    ' Determines where to display the value of variable total.
    ActiveCell.Offset(-1, 0).Select
    Do
        If ((ActiveCell.Offset(0, 2)) = emptyCell) Then
            lastColumn = True
        Else
            ActiveCell.Offset(0, 2).Select
        End If
    Loop While (lastColumn = False)
    ActiveCell.Offset(1, 0).Select
    ActiveCell.HorizontalAlignment = xlCenter
    Selection.Font.Bold = True
    ActiveCell.Value = total
End Sub
' Subroutine Name: AlleleFreq()
' Parameters Byval: numOfLoci, colonyNum
' Description: Displays allele frequencies.
Public Sub AlleleFreq(ByVal numOfLoci, ByVal colonyNum)
    ' [DECLARE VARIABLES]
    Dim lociCount As Integer, alleleCount As Integer, count As Integer, counter As Integer
    Dim testAllele As Variant, prevTested() As Variant, pivotArray() As Variant
    Dim tested As Boolean
    Dim total As Double, sumArray() As Double, freq As Double, sum As Double, avgSum As Double
    Dim emptyCell As String, specialCase As String
    Dim iterator As Integer, alleleNum As Integer, alleleArray() As Integer

    ' [INITIALISE VARAIBLES]
    emptyCell = ""
    specialCase = "*"
    ReDim pivotArray(1)
    ReDim sumArray(numOfLoci)
    avgSum = 0
    ReDim alleleArray(numOfLoci)

    For lociCount = 1 To numOfLoci
        ReDim prevTested(1)
        sum = 0
        alleleNum = 0
        For alleleCount = 1 To UBound(sortedArray, 1)
            testAllele = sortedArray(alleleCount, lociCount)
            If (testAllele <> emptyCell) Then
                total = 0
                freq = 0
                tested = False
                For count = 1 To UBound(prevTested)
                    If (testAllele = prevTested(count)) Then
                        tested = True
                        Exit For
                    End If
                Next count
            
                If (tested = False) Then
                    prevTested(UBound(prevTested)) = testAllele
                    ReDim Preserve prevTested(UBound(prevTested) + 1)
                
                    For counter = 1 To UBound(sortedArray, 1)
                        If ((testAllele = sortedArray(counter, lociCount)) And (sortedArray(counter, numOfLoci + 1) <> emptyCell)) Then
                            total = total + sortedArray(counter, numOfLoci + 1)
                        End If
                    Next counter
                    
                    freq = total / UBound(fatherArray, 2)
                    
                    sum = sum + freq
                    alleleNum = alleleNum + 1
                    sumArray(lociCount) = sum
              
                    ' Add allele to pivotArray.
                    If (testAllele = specialCase) Then
                        pivotArray(UBound(pivotArray)) = queenArray(lociCount, 1) & " / " & queenArray(lociCount, 2)
                        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
                    Else
                        pivotArray(UBound(pivotArray)) = testAllele
                        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
                    End If
                    
                    ' Add loci number to pivotArray.
                    pivotArray(UBound(pivotArray)) = lociCount
                    ReDim Preserve pivotArray(UBound(pivotArray) + 1)
                    
                    ' Add statistic class & values to pivotArray.
                    pivotArray(UBound(pivotArray)) = "Frequency"
                    ReDim Preserve pivotArray(UBound(pivotArray) + 1)
                    pivotArray(UBound(pivotArray)) = freq
                    ReDim Preserve pivotArray(UBound(pivotArray) + 1)
                End If
            End If
        Next alleleCount
        alleleArray(lociCount) = alleleNum
    Next lociCount
    
    ' Add loci heterozygosity information of each locus to pivotArray.
    For iterator = 1 To numOfLoci
        pivotArray(UBound(pivotArray)) = "Locus " & iterator
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
        pivotArray(UBound(pivotArray)) = iterator
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
        pivotArray(UBound(pivotArray)) = "Heterozygosity of Locus"
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
        pivotArray(UBound(pivotArray)) = (sumArray(iterator) / alleleArray(iterator)) * 2 * (1 - (sumArray(iterator) / alleleArray(iterator)))
        avgSum = avgSum + pivotArray(UBound(pivotArray))
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
    Next iterator
        
    ' Add overall heterozygosity to pivotArray.
    For iterator = 1 To numOfLoci
        pivotArray(UBound(pivotArray)) = "All Loci (" & iterator & ")"
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
        pivotArray(UBound(pivotArray)) = iterator
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
        pivotArray(UBound(pivotArray)) = "Overall Heterozygosity"
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
        pivotArray(UBound(pivotArray)) = (avgSum / numOfLoci) * 2 * (1 - (avgSum / numOfLoci))
        ReDim Preserve pivotArray(UBound(pivotArray) + 1)
    Next iterator
    
    ' Print out results.
    ActiveSheet.Range("A1000").Select
    ActiveCell.Value = "Alleles"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Loci"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Statistic"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Results"
    ActiveCell.Offset(1, -3).Select
    count = 0
    For iterator = 1 To UBound(pivotArray)
        ActiveCell.Value = pivotArray(iterator)
        count = count + 1
        If (count = 4) Then
            ActiveCell.Offset(1, -3).Select
            count = 0
            GoTo Skip
        End If
        ActiveCell.Offset(0, 1).Select
Skip:
    Next iterator
    Call Module9.CreatePivotTable(colonyNum)
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .RowGrand = False
    End With
    Columns("A:A").ColumnWidth = 24
    Columns("A:D").HorizontalAlignment = xlCenter
    ActiveSheet.PivotTables("PivotTable1").HasAutoFormat = False
    Application.CommandBars("PivotTable").Visible = False
    Range("A1000:D2000").Select
    Selection.Clear
    Range("A1").Select
End Sub