Viterbi Simulator (CLOSENESS)

Option Explicit

Sub RunCodingC() ' FOR CLOSENESS METHODS
    ' Run this procedure with chosen in-code settings to study the cross-decoder performance.
    ' Runs a Viterbi convolutional coder-decoder simulation for two rate 1/2 algorithms.
    ' Coder 7,6: Rate 1/2, constraint=3, gen polynomials top=(111) and bottom=(110), Dfree=4.
    ' Coder 7,5: Rate 1/2, constraint=3, gen polynomials top=(111) and bottom=(101), Dfree=5.
    ' Decoders; Viterbi to match each coder. VBA is coded for CLOSENESS as opposed to Hamming DISTANCE.
    ' Message inputs can be specified exactly, or randomly with chosen length.
    ' Error insertion can be exact, or random to a specified BER. Various error pair options exist.
    ' User set number of cycles and output choice. Message box for an all-cycle summary.
Notes:
    ' The 7,5 coding algorithm with the higher "free distance" = 5 is better than 7,6's with FD = 4.
    ' Configuration (7,6) handles single bit errors with error free gaps of at least six bits.
    ' Configuration (7,6) handles some errored pairs in a limited way for some input conditions.
    ' Configuration (7,5) handles single bit errors with error free gaps of at least five bits.
    ' Configuration (7,5) handles errored pairs also, with error free gaps of about 12 -15 bits between such pairs.
    ' Performance Compared: Random Inputs with Random Errors: For 1Mb total input:
    ' (7,6): BER 1E-3 in, 4E-6 out: BER 1E-2 in, 6E-4 out.
    ' (7,5): BER 1E-3 in, 1E-6 out: BER 1E-2 in, 3E-5 out.
    
Assignments:
    Dim oSht As Worksheet, vArr As Variant, vEM As Variant, bLucky As Boolean, vDisp As Variant
    Dim sngBerDecIn As Single, sngBER As Single, sngBerMOut As Single, nModeNumber As Integer
    Dim LB1 As Long, UB1 As Long, x As Long, nClearErrGap As Long, nNumCdrFlushBits As Long
    Dim m As Long, nLenAutoInput As Long, nAutoCycles As Long, rd As Long, cd As Long
    Dim r As Long, nLenStream As Long, nMErr As Long, nTotMErr As Long, nTotDIErr As Long
    Dim nTotLenStream As Long, nDErr As Long, nLenIntoDec As Long, nCycleToDisplay As Long
    Dim nTotMBSent As Long, nTotEBMess As Long, nNumDEPC As Long, nFirst As Long, nCodePolyGen As Integer
    Dim sDecodedMessage As String, sDM As String, sChannelRx As String, sChannelTx As String, sEdges As String
    Dim sCodedMessage As String, sMessage As String, sMW As String, sFctr As String, vT As Variant
    
    On Error GoTo ErrorHandler
    
UserSettings:
    ' Set sheet 1 for output as text
    ' worksheet will be cleared and overwritten between runs
    Set oSht = ThisWorkbook.Worksheets("Sheet1")
    ' format sheet cells
    With oSht.Columns
        .NumberFormat = "@"
        .Font.Size = 16
    End With
    oSht.Cells(1, 1).Select
    
    ' ================================================================================================================
    ' ===========================MODE NUMBER DESCRIPTIONS=============================================================
    
    ' MODE 1
    ' manual coder input- type string into variable sMessage
    ' manual decoder input errors-typed into array variable list vEM
    
    ' MODE 2
    ' manual coder input- type string into variable sMessage
    ' regular spacing of errors throughout, set gap between two errors
    ' in nClearErrGap and start position for first in nFirst
    
    ' MODE 3
    ' manual coder input- type string into variable sMessage
    ' one pair of errors only, gap between two errors is random and start
    ' position for first is set with nFirst- adjusts to input length
    
    ' MODE 4
    ' manual coder input- type string into variable sMessage
    ' auto decoder input errors- random errors with BER (bit error rate)
    ' set in sngBER
    
    ' MODE 5
    ' auto coder input- random input- length set in variable nLenAutoInput
    ' manual decoder input errors-typed into array variable list vEM
    
    ' MODE 6
    ' auto coder input- random input- length set in variable nLenAutoInput
    ' regular spacing of errors throughout, set gap between two errors in
    ' nClearErrGap and start position for first in nFirst
    
    ' MODE 7
    ' auto coder input- random input- length set in variable nLenAutoInput
    ' one pair of errors only, gap between two errors is random and start
    ' position for first is set with nFirst- adjusts to input length
    
    ' MODE 8
    ' auto coder input- random input- length set in variable nLenAutoInput
    ' auto decoder input errors- random errors with BER (bit error rate)
    ' set in sngBER
    
    ' MODE 9
    ' manual coder input- type string into variable sMessage
    ' no errors at all - no need to touch error settings
    ' -goes round error insertion
    
    ' MODE 10
    ' auto coder input- random input- length set in variable nLenAutoInput
    ' no errors at all - no need to touch error settings
    ' -goes round error insertion
    
    ' ================================================================================================================
    ' ===========================SET WORKING MODE HERE================================================================
    nCodePolyGen = 76                ' options so far are 76 for (2,1,3)(111,110) or 75 for (2,1,3)(111,101)
    nModeNumber = 1                  ' see meanings above
    
    ' ================================================================================================================
    ' ===========================COMMON PARAMETERS====================================================================
    
    nAutoCycles = 1                  ' set the number of cycles to run
    nCycleToDisplay = nAutoCycles    ' choose the cycle number for the metrics sheet output
    
    ' ================================================================================================================
    ' ===========================RANDOM INPUT BLOCK LENGTH============================================================
    
    ' USER SET BIT LENGTH FOR INPUT TO CODER - THE MESSAGE INPUT
    nLenAutoInput = 20                ' there will be double this number at decoder input
    
    ' ================================================================================================================
    ' ===========================MANUAL INPUT SETTINGS================================================================
    
    sMessage = "10110" ' for the Wiki page example
    
    ' sMessage = "10000"               ' gives impulse response 11  10  11 ...00  00  00 for 7,5
    ' sMessage = "10000"               ' gives impulse response 11  11  10 ...00  00  00 for 7,6
    ' =================================================================================================================
    ' ===========================SET BER, POSITIONS AND GAPS===========================================================
    
    nClearErrGap = 5      ' modes 2,3,7,and 6 to set an error gap
    nNumCdrFlushBits = 2  ' modes 2,3,4,6,7,and 8 to apply message end flushing
    sngBER = 0.1        ' modes 4 and 8 to insert specified bit error rate at decoder input
    nFirst = 5            ' modes 2,3,6,and 7 to set the first error position at decoder input
    
    ' =================================================================================================================
    ' ===========================MANUALLY SET ERROR PARAMETERS=========================================================
    
    ' MANUALLY SET ERROR POSITIONS - arrange list in increasing order. Applies at decoder input
    ' vEM = Array(21, 28, 35, 42, 49, 56, 62)     'for (7,6). Single errors with gaps of 6 error free bits
    ' vEM = Array(21, 27, 33, 39, 45, 52, 59)     'for (7,5). Single errors with gaps of 5 error free bits
    ' vEM = Array(21, 22, 36, 37, 52, 53, 68, 69) 'for (7,5). 4 double errors with gaps around 12 error free bits
    ' vEM = Array(20, 21)
    vEM = Array(3, 9)
    
    ' =================================================================================================================
    ' =================================================================================================================
WORKING:
    
    ' CYCLE COUNT DISPLAY SPECIFIC OVERRIDES
    Select Case nModeNumber
    Case 1, 2, 9
        nAutoCycles = 1  ' some modes need only single cycle
        nCycleToDisplay = 1
    End Select
    
    Application.DisplayStatusBar = True
    
    ' RUN A SPECIFIED NUMBER OF CYCLES
    For r = 1 To nAutoCycles
        DoEvents    ' interrupt to handle system requests
        Application.StatusBar = (r * 100) \ nAutoCycles & " Percent complete"
        
        ' CODE the message stream
        ' Decide how input is produced for each mode
        ' and add three zeros for FLUSHING
        Select Case nModeNumber
        Case 1, 2, 3, 4, 9
            If Len(sMessage) < 2 Then MsgBox "Manual input string sMessage is too short - closing": Exit Sub
            sMW = sMessage & String(nNumCdrFlushBits, "0") ' manually typed message into an array list
        Case 5, 6, 7, 8, 10
            If nLenAutoInput < 2 Then MsgBox "Short string length specified -closing": Exit Sub
            sMW = AutoRandomInputC(nLenAutoInput) & String(nNumCdrFlushBits, "0") ' auto random message
        End Select
        
        ' CODER
        ' obtain a coded message from the input
        Select Case nCodePolyGen
        Case 76
            ConvolutionalCoderT7B6C sMW, sCodedMessage
        Case 75
            ConvolutionalCoderT7B5C sMW, sCodedMessage
        Case Else
            MsgBox "Chosen algorithm not found - closing"
            Exit Sub
        End Select
        sChannelTx = sCodedMessage
        
        ' check that manual error selection will fit the stream
        ' auto errors have own checks
        Select Case nModeNumber
        Case 1, 5
            LB1 = LBound(vEM, 1): UB1 = UBound(vEM, 1)
            ' check whether positions are possible
            For x = LB1 To UB1
                If vEM(x) > (2 * Len(sMW)) Then
                    MsgBox "Manually selected bit positions don't fit the stream." & vbCrLf & _
                    "Increase input length or change the bit positions." & vbCrLf & _
                    "Closing."
                    Exit Sub
                End If
            Next x
        End Select
        
        ' ERRORS
        ' ADD ERRORS to sChannelTX to simulate channel noise
        ' Decide how errors are inserted for each mode
        Select Case nModeNumber
        Case 1, 5   ' manual error assignment
            sChannelRx = AddFixedErrsC(sChannelTx, vEM)
        Case 2, 6   ' two error spacing, manual gap and start
            sChannelRx = FixedSpacedErrorsC(sChannelTx, nFirst, nClearErrGap, 0)
        Case 3, 7   ' two errors only, random gap and manual start
            sChannelRx = TwoErrOnlyRndGapC(sChannelTx, nFirst, 0)
        Case 4, 8   ' auto random errors to manual BER setting
            sChannelRx = InsertBERRndC(sChannelTx, sngBER, 0)
        Case 9, 10  ' no errors at all
            sChannelRx = sChannelTx
        End Select
        
        ' DECODER
        ' DECODE the errored bit stream - proc uses Viterbi algorithm
        Select Case nCodePolyGen
        Case 76
            ConvolutionalDecodeC sChannelRx, sDecodedMessage, sEdges, bLucky, 76, vArr, vT
        Case 75
            ConvolutionalDecodeC sChannelRx, sDecodedMessage, sEdges, bLucky, 75, vArr, vT
        Case Else
            MsgBox "Configuration not defined - 75 or 76 only - closing"
            Exit Sub
        End Select
        sDM = sDecodedMessage
        
        ' SELECTIVE DISPLAY FOR SHEET - display for any ONE cycle
        If Application.ScreenUpdating = True Then Application.ScreenUpdating = False
        If r = nCycleToDisplay And nCycleToDisplay <> 0 Then
            oSht.Activate
            oSht.Cells.ClearContents             'remove text
            oSht.Cells.Interior.Pattern = xlNone 'remove color fill
            ' chosen run metrics to sheet
            For rd = LBound(vArr, 2) To UBound(vArr, 2)
                For cd = LBound(vArr, 1) To UBound(vArr, 1)
                    oSht.Cells(rd, cd + 1) = CStr(vArr(cd, rd))
                Next cd
            Next rd
            With oSht ' block in unused nodes and add notes
                .Cells(1, 1) = "0"
                .Cells(2, 1) = "*"
                .Cells(3, 1) = "*"
                .Cells(4, 1) = "*"
                .Cells(2, 2) = "*"
                .Cells(4, 2) = "*"
                .Cells(12, 1) = "Notes:": .Cells(12, 2) = "Currently using (" & nCodePolyGen & ") configuration."
                .Cells(13, 1) = "m:"
                .Cells(14, 1) = "c:"
                .Cells(15, 1) = "r:"
                .Cells(16, 1) = "r*:"
                .Cells(17, 1) = "m*:"
                .Cells(13, 2) = "The original message stream:"
                .Cells(14, 2) = "The coded output stream:"
                .Cells(15, 2) = "The coded output with any channel errors in magenta:"
                .Cells(16, 2) = "The back path edge values:"
                .Cells(17, 2) = "The recovered message with any remaining errors in red:"
                .Cells(18, 2) = "The decoder back path is shown in yellow:"
            End With
            oSht.Range(Cells(13, 2), Cells(18, 2)).Font.Italic = True
            
            DigitsToSheetRowC sMW, 1, 6, "m"               ' message in
            DigitsToSheetRowC sChannelTx, 2, 7, "c"        ' correctly coded message
            DigitsToSheetRowC sChannelRx, 2, 8, "r"        ' coded message as received
            DigitsToSheetRowC sEdges, 2, 9, "r*"           ' back path edge values
            DigitsToSheetRowC sDecodedMessage, 1, 10, "m*" ' message out
            
            ' tint the back path cells
            For cd = LBound(vT, 1) To UBound(vT, 1)
                ' MsgBox vT(cd, 1) & " " & vT(cd, 2)
                oSht.Cells(vT(cd, 1), vT(cd, 2) + 1).Interior.Color = RGB(249, 216, 43) ' yellow-orange
            Next cd
        End If
        
        ' IN-LOOP DATA COLLECTION
        ' ACCUMULATE DATA across all cycles
        nMErr = NumBitsDifferentC(sMW, sDM, nLenStream)                ' message errors single cycle
        nDErr = NumBitsDifferentC(sChannelRx, sChannelTx, nLenIntoDec) ' num decoder input errors single cycle
        nTotLenStream = nTotLenStream + nLenStream                    ' accum num message bits all cycles
        nTotMErr = nTotMErr + nMErr                                   ' accum num message error bits all cycles
        nTotDIErr = nTotDIErr + nDErr                                 ' accum num decoder input errors all cycles
        
        ' reset cycle error counters
        nDErr = 0: nDErr = 0
    Next r ' end of main cycle counter
    
Transfers:
    
    ' HIGHLIGHT ERRORS ON WORKSHEET - message bit errors red, changes to back path magenta
    ColourTheErrors Len(sMW) 'colours length of input block plus flushing    
    
    ' PREPARE ALL-CYCLE SUMMARY
    nTotMBSent = nTotLenStream                               ' accum num message bits all cycles
    nTotEBMess = nTotMErr                                    ' accum num message err bits all cycles
    nNumDEPC = nTotDIErr / nAutoCycles                       ' num input errors added decoder input each cycle
    sngBerDecIn = Round(nTotDIErr / (nTotMBSent * 2), 10)    ' channel BER decoder input all cycles
    sngBerMOut = Round(nTotEBMess / nTotMBSent, 10)          ' message BER decoder output all cycles
    If sngBerMOut = 0 Then
        sFctr = "Perfect"
    Else
        sFctr = Round(sngBerDecIn / sngBerMOut, 1)           ' BER improvement across decoder
    End If
    
    ' OUTPUT SUMMARY
    MsgBox "Total of all message bits sent   : " & nTotMBSent & vbCrLf & _
    "Total errored bits in all received messages   : " & nTotEBMess & vbCrLf & _
    "Number channel errors per cycle   : " & nNumDEPC & " in block lengths of   : " & nLenIntoDec & vbCrLf & _
    "BER applied over all decoder input   : " & sngBerDecIn & " : " & sngBerDecIn * 100 & "%" & vbCrLf & _
    "BER for all messages out of decoder   : " & sngBerMOut & " : " & sngBerMOut * 100 & "%" & vbCrLf & _
    "Improvement factor across decoder   : " & sFctr
    
    ' RESETS
    If Application.ScreenUpdating = False Then Application.ScreenUpdating = True
    Application.StatusBar = ""
    
    Exit Sub
    
ErrorHandler:
    If Err.Number <> 0 Then
        Select Case Err.Number
        Case 13 ' early exit for certain settings mistakes
            Err.Clear
            Exit Sub
        Case Else
            MsgBox "Error number: " & Err.Number & vbNewLine & _
            "Error source: " & Err.Source & vbNewLine & _
            "Description: " & Err.Description & vbNewLine
            Err.Clear
            Exit Sub
        End Select
    End If
End Sub

Function ConvolutionalCoderT7B5C(ByVal sInBitWord As String, sOut As String)
    ' rate 1/2 coder; one bit in leads to two bits out
    ' 3 register equivalent, constraint 3
    ' generator polynomials are top = (1,1,1) and bottom = (1,0,1)
    ' taken for output first top then bottom
    
    Dim x0 As Long, x1 As Long, x2 As Long
    Dim sOut7 As String, sOut5 As String
    Dim n As Long, sOutBitWord As String
    
    If sInBitWord = "" Or Len(sInBitWord) < 5 Then
        MsgBox "Longer input required for ConvolutionalCoder - closing"
        Exit Function
    End If
    
    ' itialise all registers with zeros
    x0 = 0: x1 = 0: x2 = 0
    
    ' run the single input bits through the shift register
    For n = 1 To Len(sInBitWord) ' this includes any flushing bits
        DoEvents
        ' shift in one bit
        x2 = x1                          ' second contents into third position
        x1 = x0                          ' first contents into second position
        x0 = CLng(Mid(sInBitWord, n, 1)) ' new bit into first
        
        ' combine register outputs
        sOut7 = x0 Xor x1 Xor x2         ' top adder output
        sOut5 = x0 Xor x2                ' bottom adder output
        
        ' combine and accumulate two adder results
        sOutBitWord = sOutBitWord & sOut7 & sOut5
        sOut = sOutBitWord
    Next n
    
End Function

Function ConvolutionalCoderT7B6C(ByVal sInBitWord As String, sOut As String)
    ' rate 1/2 coder; one bit in leads to two bits out
    ' 3 register equivalent, constraint 3
    ' generator polynomials are top = (1,1,1) and bottom = (1,1,0)
    ' taken for output first top then bottom
    
    Dim x0 As Long, x1 As Long, x2 As Long
    Dim sOut7 As String, sOut6 As String
    Dim n As Long, sOutBitWord As String
    
    If sInBitWord = "" Or Len(sInBitWord) < 5 Then
        MsgBox "Longer input required for ConvolutionalCoder - closing"
        Exit Function
    End If
    
    ' itialise all registers with zeros
    x0 = 0: x1 = 0: x2 = 0
    
    ' run the single input bits through the shift register
    For n = 1 To Len(sInBitWord) ' this includes any flushing bits
        DoEvents
        ' shift in one bit
        x2 = x1                          ' second contents into third position
        x1 = x0                          ' first contents into second position
        x0 = CLng(Mid(sInBitWord, n, 1)) ' new bit into first
        
        ' combine register outputs
        sOut7 = x0 Xor x1 Xor x2         ' top adder output
        sOut6 = x0 Xor x1                ' bottom adder output
        
        ' combine and accumulate two adder results
        sOutBitWord = sOutBitWord & sOut7 & sOut6
        sOut = sOutBitWord
    Next n
    
End Function

Function FixedSpacedErrorsC(ByVal sIn As String, ByVal nStart As Long, ByVal nErrFreeSpace As Long, _
    nTail As Long, Optional nErrCount As Long) As String
    
    ' returns parameter input string in function name with errors added
    ' at fixed intervals, set by nERRFreeSpace, the error free space between errors,
    ' and sequence starts with position nStart.   Total number of errors placed is found in option parameter nErrCount
    ' nTail is the number of end bits to keep clear of errors.
    
    Dim n As Long, nLen As Long, nWLen As Long, sAccum As String, c As Long, sSamp As String, nModBit As Long
    
    ' check for an empty input string
    If sIn = "" Then
        MsgBox "Empty string input in FixedSpacedErrors - closing"
        Exit Function
    End If
    
    ' get length of input less tail piece
    nWLen = Len(sIn) - nTail
    
    ' check length of input sufficient for parameters
    If nWLen - nStart < nErrFreeSpace + 1 Then
        MsgBox "Input too short in FixedSpacedErrors - increase length -closing"
        Exit Function
    End If
    
    ' accum the part before the start error
    sAccum = Mid$(sIn, 1, nStart - 1)
    
    ' modify the bit in start position and accum result
    sSamp = Mid$(sIn, nStart, 1)
    nModBit = CLng(sSamp) Xor 1
    sAccum = sAccum & CStr(nModBit)
    nErrCount = 1      ' count one error added
    
    ' insert fixed interval errors thereafter
    For n = nStart + 1 To nWLen
        sSamp = Mid$(sIn, n, 1)
        c = c + 1
        If c = nErrFreeSpace + 1 And n <= nWLen Then ' do the stuff
            c = 0
            nModBit = CLng(sSamp Xor 1)
            sAccum = sAccum & CStr(nModBit)
            nErrCount = nErrCount + 1
        Else
            sAccum = sAccum & sSamp
        End If
    Next n
    
    FixedSpacedErrorsC = sAccum
    
End Function

Function TwoErrOnlyRndGapC(ByVal sIn As String, ByVal nStart As Long, ByVal nTail As Long) As String
    ' returns input string in function name with only 2 added errors, the first at parameter position and
    ' the second after a random gap.
    ' nTail is the number of end bits to keep clear of errors.
    
    Dim nReqNumErr As Long, nSample As Long, r As Long, c As Long
    Dim vA() As Long, nRange As Long, nCount As Long, sAccum As String
    
    ' find length free of tail bits
    nRange = Len(sIn) - nTail
    
    ' check that sIn is long enough
    If nRange < nStart + 1 Then
        MsgBox "sIn too short for start point in TwoErrOnlyRndGap - closing"
        Exit Function
    End If
    
    ' set number of errors needed
    nReqNumErr = 2 ' one start and one random
    
    ' dimension an array to hold the work
    ReDim vA(1 To Len(sIn), 1 To 3)
    
    ' load array col 1 with the input bits
    ' and mark the start bit for error
    For r = LBound(vA, 1) To UBound(vA, 1)
        vA(r, 1) = CLng(Mid$(sIn, r, 1))
        If r = nStart Then ' mark start bit with flag
            vA(r, 2) = 1
        End If
    Next r
    
    ' mark intended positions until right number of
    ' non-overlapping errors is clear
    Do Until nCount = nReqNumErr
        nCount = 0 ' since first err in place
        DoEvents
        ' get a sample of row numbers in the working range
        nSample = Int((nRange - (nStart + 1) + 1) * Rnd + (nStart + 1))
        ' error flag added to col 2 of intended row
        vA(nSample, 2) = 1 ' 1 denotes intention
        
        ' run through array col 1
        For c = LBound(vA, 1) To UBound(vA, 1)
            ' count all intention markers so far
            If vA(c, 2) = 1 Then
                nCount = nCount + 1
            End If
        Next c
    Loop
    
    ' when num errors is right modify the ones flagged
    For r = LBound(vA, 1) To UBound(vA, 1)
        sAccum = sAccum & CStr(vA(r, 1) Xor vA(r, 2))
    Next r
    
    TwoErrOnlyRndGapC = sAccum
    
End Function

Function AddFixedErrsC(ByVal sIn As String, vA As Variant) As String
    ' returns string in function name with errors added in fixed positions.
    ' positions are set by one dimensional list in vA array
    
    Dim c As Long, nPosition As Long, UB1 As Long, LB1 As Long
    Dim sSamp As String, sWork As String, sSamp2 As String, sAccum As String
    
    LB1 = LBound(vA, 1): UB1 = UBound(vA, 1)
    
    sWork = sIn
    For nPosition = LB1 To UB1 ' 0 to 2 eg
        For c = 1 To Len(sWork)
            sSamp = Mid$(sWork, c, 1)
            If c = vA(nPosition) Then
                sSamp2 = (1 Xor CLng(sSamp))
                sAccum = sAccum & sSamp2
            Else
                sAccum = sAccum & sSamp
            End If
        Next c
        sWork = sAccum
        sAccum = ""
    Next nPosition
    
    AddFixedErrsC = sWork
    
End Function

Function InsertBERRndC(ByVal sIn As String, ByVal BER As Single, ByVal nTail As Long) As String
    ' returns input string of bits with added random errors in function name
    ' number of errors depends on length of sIn and BER parameter
    ' Set nTail to zero to apply errors to flushing bits too
    
    Dim nReqNumErr As Long, nSample As Long, r As Long, c As Long
    Dim vA() As Long, nRange As Long, nCount As Long, sAccum As String
    
    ' find length free of nTail eg, remove flushing
    nRange = Len(sIn) - nTail
    
    ' find number of errors that are needed
    nReqNumErr = CLng(BER * nRange) ' Clng rounds fractions
    If nReqNumErr < 1 Then
        MsgBox "Requested error rate produces less than one error in InsertBERRnd" & vbCrLf & _
        "Increase stream length, or reduce BER, or both - closing"
        Exit Function
    End If
    
    ' dimension an array to hold the work
    ReDim vA(1 To Len(sIn), 1 To 3)
    
    ' load array col 1 with the input bits
    For r = LBound(vA, 1) To UBound(vA, 1)
        vA(r, 1) = CLng(Mid$(sIn, r, 1))
    Next r
    
    ' mark intended positions until right number of
    ' non-overlapping errors is clear
    Do Until nCount = nReqNumErr
        nCount = 0
        DoEvents
        ' get a sample of row numbers in the working range
        nSample = Int((nRange - 1 + 1) * Rnd + 1)
        ' error flag added to col 2 of intended row
        vA(nSample, 2) = 1 ' 1 denotes intention
        
        ' run through array col 1
        For c = LBound(vA, 1) To UBound(vA, 1)
            ' count all intention markers so far
            If vA(c, 2) = 1 Then
                nCount = nCount + 1
            End If
        Next c
    Loop
    
    ' when num errors is right modify the ones flagged
    For r = LBound(vA, 1) To UBound(vA, 1)
        sAccum = sAccum & CStr(vA(r, 1) Xor vA(r, 2))
    Next r
    
    InsertBERRndC = sAccum
    
End Function

Sub ConvolutionalDecodeC(ByVal sIn As String, sOut As String, sOut2 As String, bAmbiguous As Boolean, _
                         nConfiguration As Long, vRet As Variant, vTint As Variant)
    ' works with rate 1/2 coder; one bit in leads to two bits out
    ' 3 register equivalent, constraint 3, generator polynomials are top = (1,1,1) and bottom = (1,1,0) for 7,6
    ' and (1,1,1) and (1,0,1) for 7,5, selected by parameter nConfiguration= 75 or 76.
    
    ' NOTES: All calculations of metrics use maximum closeness as opposed to Hamming distance.
    '       In branch estimates the lowest total is always discarded.
    '       If branch metrics are equal, discard the bottom of the two incoming branches.
    '       Working for metrics assumes position at node with two incoming branches.
    '       Back track starts at last column's metric maximum then follows survivor paths
    '       back to state "a" time zero.
    
    Dim aV() As String, vH As Variant, sWIn As String, sPrevStateAccumL As String, sPrevStateAccumU As String
    Dim nStartR As Long, nStartC As Long, sEdgeBits As String, sInputBit As String
    Dim r As Long, c As Long, nSwapR As Long, nSwapC As Long
    Dim nVert As Long, nTime As Long, bUpperPath As Boolean, vW As Variant
    Dim sAccumEdgeValues As String, sAccumImpliesBits As String
    Dim sCurrState As String, sPrevStateU As String, sPrevStateL As String, sUSOut As String, sLSOut As String
    Dim sBitU As String, sBitL As String, sRcdBits As String, nNumTrans As Long
    Dim sProposedAccumU As String, sProposedAccumL As String, sDiscardedU As String, sDiscardedL As String
    Dim sNodeAccum As String, sBackStateU As String, sBackStateL As String, nNumHighs As Long
    
    ' check that number received is even
    sWIn = sIn
    If Len(sWIn) Mod 2 = 0 Then
        nNumTrans = Len(sWIn) / 2
    Else
        MsgBox "Odd bit pairing at input decoder -closing"
        Exit Sub
    End If
    
    ' dimension arrays
    Erase aV()
    ReDim aV(0 To nNumTrans, 1 To 4, 1 To 3)  ' x transitions, y states, z node data
    ReDim vH(1 To 4, 1 To 3)                  ' r states, c node data
    ReDim vW(0 To nNumTrans, 1 To 4)          ' r transitions, c states
    ReDim vTint(0 To nNumTrans, 1 To 2)
    aV(0, 1, 3) = "0"                         ' set metric for zero node
    
    ' CYCLE LOOP
    For nTime = 1 To nNumTrans
        For nVert = 1 To 4
            DoEvents
            
            ' Get incoming branch data for current node
            If nConfiguration = 75 Then
                GeneralDataT7B5C nVert, sCurrState, sPrevStateU, sPrevStateL, sUSOut, sLSOut, sBitU, sBitL
            ElseIf nConfiguration = 76 Then
                GeneralDataT7B6C nVert, sCurrState, sPrevStateU, sPrevStateL, sUSOut, sLSOut, sBitU, sBitL
            End If
            
            ' Get the received bits for the incoming transition
            sRcdBits = Mid$(sWIn, (nTime * 2) - 1, 2)
            
            ' get the current node's previous states' metrics
            If sCurrState = "a" And sPrevStateU = "a" Then sPrevStateAccumU = aV(nTime - 1, 1, 3)
            If sCurrState = "a" And sPrevStateL = "b" Then sPrevStateAccumL = aV(nTime - 1, 2, 3)
            If sCurrState = "b" And sPrevStateU = "c" Then sPrevStateAccumU = aV(nTime - 1, 3, 3)
            If sCurrState = "b" And sPrevStateL = "d" Then sPrevStateAccumL = aV(nTime - 1, 4, 3)
            If sCurrState = "c" And sPrevStateU = "a" Then sPrevStateAccumU = aV(nTime - 1, 1, 3)
            If sCurrState = "c" And sPrevStateL = "b" Then sPrevStateAccumL = aV(nTime - 1, 2, 3)
            If sCurrState = "d" And sPrevStateU = "c" Then sPrevStateAccumU = aV(nTime - 1, 3, 3)
            If sCurrState = "d" And sPrevStateL = "d" Then sPrevStateAccumL = aV(nTime - 1, 4, 3)
            
            ' NOTE ON EXCEPTIONS
            ' Exceptions for transitions 0, 1 and 2.  Some redundant, or fewer than two incoming branches.
            ' Nodes with single incoming branches; mark blind branches same edge value as existing edge,
            ' and mark their previous metrics as zeros.  Because policy for choosing equal metrics is always
            ' to discard the bottom one, exceptions can then be handled in same loop.
            ' Zero column is handled entirely by settings for transition 1.
            
            ' Apply exceptions settings
            If nConfiguration = 75 Then
                FrontExceptions75C nTime, nVert, sLSOut, sUSOut, sPrevStateAccumL, sPrevStateAccumU
            ElseIf nConfiguration = 76 Then
                FrontExceptions76C nTime, nVert, sLSOut, sUSOut, sPrevStateAccumL, sPrevStateAccumU
            End If
            
            ' Calculate incoming branch metrics and add their previous path metrics to each
            sProposedAccumU = GetProposedAccumC(sRcdBits, sUSOut, sPrevStateAccumU)
            sProposedAccumL = GetProposedAccumC(sRcdBits, sLSOut, sPrevStateAccumL)
            
            ' Decide between the two proposed metrics for the current node
            ' Accept the higher value branch metric and discard the other
            ' If same in value, choose the top branch and discard the bottom.
            If CLng(sProposedAccumU) > CLng(sProposedAccumL) Then
                sDiscardedL = "Discard": sDiscardedU = "Keep"
                sNodeAccum = sProposedAccumU
            ElseIf CLng(sProposedAccumU) < CLng(sProposedAccumL) Then
                sDiscardedL = "Keep": sDiscardedU = "Discard"
                sNodeAccum = sProposedAccumL
            ElseIf CLng(sProposedAccumU) = CLng(sProposedAccumL) Then
                sDiscardedL = "Discard": sDiscardedU = "Keep"
                sNodeAccum = sProposedAccumU
            End If
            
            ' Update the node array with the discard data
            aV(nTime, nVert, 1) = sDiscardedU  ' whether or not upper incoming discarded
            aV(nTime, nVert, 2) = sDiscardedL  ' whether or not lower incoming discarded
            
            ' Update the node array with the value of path metric for the current node
            aV(nTime, nVert, 3) = sNodeAccum   ' update work array with metric
            
            ' Update return work array with node metric value
            vW(nTime, nVert) = CLng(sNodeAccum) ' update return display array with metric
            
        Next nVert
    Next nTime
    
    ' Transfer last column metric values to a work array
    c = nNumTrans                      ' the last column number
    For r = 1 To 4                     ' number of rows in every column
        vH(r, 1) = CLng(aV(c, r, 3))   ' metrics
        vH(r, 2) = CLng(c)             ' column where metric found in main array
        vH(r, 3) = CLng(r)             ' row where metric found in main array
    Next r
    
    ' Sort the last column values to place highest metric at top
    SortMetricsArr2D1KeyC vH, 0, 1, 1        ' and assoc recs are in same row
    
    ' Detect start point ambiguity for possible future use
    ' Count number of entries with same high value in column
    nNumHighs = 0
    For r = 1 To 4   ' number rows in every column
        If vH(1, 1) = vH(r, 1) Then nNumHighs = nNumHighs + 1
    Next r
    If nNumHighs > 1 Then bAmbiguous = True
    
    ' Note the row and column numbers for the back path start point
    nStartR = CLng(vH(1, 3))               ' retrieve row number
    nStartC = CLng(vH(1, 2))               ' retrieve col number
    
    ' add coordinates to vTint
    vTint(nStartC, 1) = nStartR
    vTint(nStartC, 2) = nStartC
    
    ' BACK PATH
    ' Navigate the back path and extract its data
    Do Until nStartC <= 0
        DoEvents  ' allow system requests
        
        ' Find survivor path into this node
        ' if upperpath is open...
        If aV(nStartC, nStartR, 1) = "Keep" Then bUpperPath = True Else bUpperPath = False
        ' if lower path is open...
        If aV(nStartC, nStartR, 2) = "Keep" Then bUpperPath = False Else bUpperPath = True
        
        ' Get present state
        sCurrState = GetStateFmRowC(nStartR)
        
        ' Use present state name to fetch the output bits
        If nConfiguration = 75 Then
            GetOutputBitsT7B5C sCurrState, bUpperPath, sEdgeBits, sInputBit
        ElseIf nConfiguration = 76 Then
            GetOutputBitsT7B6C sCurrState, bUpperPath, sEdgeBits, sInputBit
        Else
            MsgBox "Configuration not defined"
        End If
        
        ' Accumulate output and input values for hop
        sAccumEdgeValues = sEdgeBits & sAccumEdgeValues    ' edge values -not used
        sAccumImpliesBits = sInputBit & sAccumImpliesBits  ' decoded message -used
        
        ' Get array coordinates for next node in back path
        If nConfiguration = 75 Then
            GetPosOfSourceT7B5C nStartR, nStartC, bUpperPath, nSwapR, nSwapC
        ElseIf nConfiguration = 76 Then
            GetPosOfSourceT7B6C nStartR, nStartC, bUpperPath, nSwapR, nSwapC
        Else
            MsgBox "Configuration not defined"
        End If
        
        ' Update the new position coordinates for the next hop
        nStartR = nSwapR
        nStartC = nSwapC
        
        ' add coordinates to vTint
        vTint(nStartC, 1) = nStartR
        vTint(nStartC, 2) = nStartC
        
    Loop
    
Transfers:
    
    ReDim vRet(LBound(vW, 1) To UBound(vW, 1), LBound(vW, 2) To UBound(vW, 2))
    vRet = vW
    sOut = sAccumImpliesBits 'single bit message from back path
    sOut2 = sAccumEdgeValues 'double bit back path edge outputs
    
End Sub

Function GetStateFmRowC(nRow As Long) As String
    ' returns alpha name of state for parameter
    ' row position in trellis column
    
    Select Case nRow
    Case 1
        GetStateFmRowC = "a"
    Case 2
        GetStateFmRowC = "b"
    Case 3
        GetStateFmRowC = "c"
    Case 4
        GetStateFmRowC = "d"
    End Select
    
End Function

Function FrontExceptions75C(ByVal nT As Long, ByVal nV As Long, _
    sLSO As String, sUSO As String, sPSAL As String, sPSAU As String) As Boolean
    ' applies the exceptions for configuration 7,5 - applies to closeness only
    
    If nT = 1 And nV = 1 Then
        sLSO = "00": sUSO = "00": sPSAL = "0": sPSAU = "0"
    ElseIf nT = 1 And nV = 3 Then
        sLSO = "11": sUSO = "11": sPSAL = "0": sPSAU = "0"
    ElseIf nT = 2 And nV = 1 Then
        sLSO = "00": sUSO = "00": sPSAL = "0"
    ElseIf nT = 2 And nV = 2 Then
        sLSO = "10": sUSO = "10": sPSAL = "0"
    ElseIf nT = 2 And nV = 3 Then
        sLSO = "11": sUSO = "11": sPSAL = "0"
    ElseIf nT = 2 And nV = 4 Then
        sLSO = "01": sUSO = "01": sPSAL = "0"
    End If
    
    FrontExceptions75C = True
    
End Function

Function FrontExceptions76C(ByVal nT As Long, ByVal nV As Long, _
    sLSO As String, sUSO As String, sPSAL As String, sPSAU As String) As Boolean
    ' applies the exceptions for configuration 7,5 -applies to closeness only
    
    If nT = 1 And nV = 1 Then
        sLSO = "00": sUSO = "00": sPSAL = "0": sPSAU = "0"
    ElseIf nT = 1 And nV = 3 Then
        sLSO = "11": sUSO = "11": sPSAL = "0": sPSAU = "0"
    ElseIf nT = 2 And nV = 1 Then
        sLSO = "00": sUSO = "00": sPSAL = "0" ' arbitrarily high
    ElseIf nT = 2 And nV = 2 Then
        sLSO = "11": sUSO = "11": sPSAL = "0"
    ElseIf nT = 2 And nV = 3 Then
        sLSO = "11": sUSO = "11": sPSAL = "0"
    ElseIf nT = 2 And nV = 4 Then
        sLSO = "00": sUSO = "00": sPSAL = "0"
    End If
    
    FrontExceptions76C = True
    
End Function

Function SortMetricsArr2D1KeyC(ByRef vA As Variant, _
    Optional ByVal bIsAscending As Boolean = True, _
    Optional ByVal bIsRowSort As Boolean = True, _
    Optional ByVal SortIndex As Long = -1, _
    Optional ByRef vRet As Variant) As Boolean
    ' --------------------------------------------------------------------------------
    ' Procedure : Sort2DArr
    ' Purpose   : Bubblesorts a 2D array on 1 key, up or down, on any column or row.
    '             Options include in-place, with the source changed, or
    '             returned in vRet, with the source array intact.
    '             Optional parameters default to: ROW SORT in place, ASCENDING,
    '             using COLUMN ONE as the key.
    ' --------------------------------------------------------------------------------
    
    Dim condition1 As Boolean, vR As Variant
    Dim i As Long, j As Long, y As Long, t As Variant
    Dim loR As Long, hiR As Long, loC As Long, hiC As Long
    Dim bWasMissing As Boolean
    
    ' find bounds of vA data input array
    loR = LBound(vA, 1): hiR = UBound(vA, 1)
    loC = LBound(vA, 2): hiC = UBound(vA, 2)
    
    ' find whether optional vR was initially missing
    bWasMissing = IsMissing(vRet)
    ' If Not bWasMissing Then Set vRet = Nothing
    
    ' check input range of SortIndex
    If bIsRowSort And (SortIndex < loC Or SortIndex > hiC) Then
        MsgBox "SortIndex out of bounds in Sort2DArr; closing now"
        Exit Function
    Else:
    End If
    
    If Not bIsRowSort And (SortIndex < loR Or SortIndex > hiR) Then
        MsgBox "SortIndex out of bounds in Sort2DArr; closing now"
        Exit Function
    Else:
    End If
    
    ' pass to a work variable
    vR = vA
    
    ' steer input options
    If bIsRowSort Then GoTo ROWSORT Else GoTo COLSORT
    
ROWSORT:
    For i = loR To hiR - 1
        For j = loR To hiR - 1
            If bIsAscending Then
                condition1 = vR(j, SortIndex) > vR(j + 1, SortIndex)
            Else
                condition1 = vR(j, SortIndex) < vR(j + 1, SortIndex)
            End If
            If condition1 Then
                For y = loC To hiC
                    t = vR(j, y)
                    vR(j, y) = vR(j + 1, y)
                    vR(j + 1, y) = t
                Next y
            End If
        Next
    Next
    GoTo Transfers
    
COLSORT:
    For i = loC To hiC - 1
        For j = loC To hiC - 1
            If bIsAscending Then
                condition1 = vR(SortIndex, j) > vR(SortIndex, j + 1)
            Else
                condition1 = vR(SortIndex, j) < vR(SortIndex, j + 1)
            End If
            If condition1 Then
                For y = loR To hiR
                    t = vR(y, j)
                    vR(y, j) = vR(y, j + 1)
                    vR(y, j + 1) = t
                Next y
            End If
        Next
    Next
    GoTo Transfers
    
Transfers:
    ' decide whether to return in vA or vRet
    If Not bWasMissing Then
        ' vRet was the intended return array
        ' so return vRet leaving vA intact
        vRet = vR
    Else:
        ' vRet is not intended return array
        ' so reload vA with vR
        vA = vR
    End If
    
    ' set return function value
    SortMetricsArr2D1KeyC = True
    
End Function

Function GeneralDataT7B5C(nVert As Long, sCState As String, sPrevStateU As String, sPrevStateL As String, sUSOut As String, _
    sLSOut As String, sBitU As String, sBitL As String) As Boolean
    ' takes as input nVert as position in trellis column and returns various data for that state
    
    Select Case nVert
    Case 1
        sCState = "a": sPrevStateU = "a": sPrevStateL = "b": sUSOut = "00": sLSOut = "11": sBitU = "0": sBitL = "0"
    Case 2
        sCState = "b": sPrevStateU = "c": sPrevStateL = "d": sUSOut = "10": sLSOut = "01": sBitU = "0": sBitL = "0"
    Case 3
        sCState = "c": sPrevStateU = "a": sPrevStateL = "b": sUSOut = "11": sLSOut = "00": sBitU = "1": sBitL = "1"
    Case 4
        sCState = "d": sPrevStateU = "c": sPrevStateL = "d": sUSOut = "01": sLSOut = "10": sBitU = "1": sBitL = "1"
    Case Else
    End Select
    
    GeneralDataT7B5C = True
    
End Function

Function GeneralDataT7B6C(nVert As Long, sCState As String, sPrevStateU As String, sPrevStateL As String, sUSOut As String, _
    sLSOut As String, sBitU As String, sBitL As String) As Boolean
    ' takes as input nVert as position in trellis column and returns various data for that state
    
    Select Case nVert
    Case 1
        sCState = "a": sPrevStateU = "a": sPrevStateL = "b": sUSOut = "00": sLSOut = "10": sBitU = "0": sBitL = "0"
    Case 2
        sCState = "b": sPrevStateU = "c": sPrevStateL = "d": sUSOut = "11": sLSOut = "01": sBitU = "0": sBitL = "0"
    Case 3
        sCState = "c": sPrevStateU = "a": sPrevStateL = "b": sUSOut = "11": sLSOut = "01": sBitU = "1": sBitL = "1"
    Case 4
        sCState = "d": sPrevStateU = "c": sPrevStateL = "d": sUSOut = "00": sLSOut = "10": sBitU = "1": sBitL = "1"
    Case Else
    End Select
    
    GeneralDataT7B6C = True
    
End Function

Function GetProposedAccumC(sRcd As String, sOut As String, sPrevStateAccum As String) As String
    ' returns one branch metric in function based on previous state metric, input, and edge value.
    
    Dim nBit As Long, n As Long, m As Long, nTemp As Long
    
    If sRcd = "" Then sRcd = "00"
    
    For n = 1 To 2
        nBit = CLng(Mid$(sOut, n, 1)) Xor CLng(Mid$(sRcd, n, 1))
        m = m + nBit
    Next n
    If sPrevStateAccum = "" Then sPrevStateAccum = "0"
    nTemp = Abs(m - 2) + CLng(sPrevStateAccum)
    
    GetProposedAccumC = CStr(nTemp)
    
End Function

Function GetOutputBitsT7B5C(sState As String, bUpper As Boolean, _
    sEdgeBits As String, sInputBit As String) As Boolean
    ' returns edge value and input given the alpha state name
    ' and choice of top or bottom branch.
    ' Applies to incoming branches joining at the node.
    
    Select Case sState
    Case "a"
        If bUpper = True Then
            sEdgeBits = "00"
            sInputBit = "0"
        Else
            sEdgeBits = "11"
            sInputBit = "0"
        End If
    Case "b"
        If bUpper = True Then
            sEdgeBits = "10"
            sInputBit = "0"
        Else
            sEdgeBits = "01"
            sInputBit = "0"
        End If
    Case "c"
        If bUpper = True Then
            sEdgeBits = "11"
            sInputBit = "1"
        Else
            sEdgeBits = "00"
            sInputBit = "1"
        End If
    Case "d"
        If bUpper = True Then
            sEdgeBits = "01"
            sInputBit = "1"
        Else
            sEdgeBits = "10"
            sInputBit = "1"
        End If
    End Select
    
    GetOutputBitsT7B5C = True
    
End Function

Function GetPosOfSourceT7B5C(nNodeR As Long, nNodeC As Long, bUpper As Boolean, _
    nEdgeSourceR As Long, nEdgeSourceC As Long) As Boolean
    ' returns the array column and row for an incoming branch,
    ' given its position in trellis column and choice of top or bottom branch.
    
    Dim sNodesState As String
    
    ' convert to string state names
    Select Case nNodeR
    Case 1
        sNodesState = "a"
    Case 2
        sNodesState = "b"
    Case 3
        sNodesState = "c"
    Case 4
        sNodesState = "d"
    End Select
    
    ' for c=0 only
    If nNodeC = 0 Then
        MsgBox "No source beyond zero column"
        Exit Function
    End If
    
    ' For c>0 only
    Select Case sNodesState
    Case "a"
        If bUpper = True Then
            nEdgeSourceR = 1
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 2
            nEdgeSourceC = nNodeC - 1
        End If
    Case "b"
        If bUpper = True Then
            nEdgeSourceR = 3
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 4
            nEdgeSourceC = nNodeC - 1
        End If
    Case "c"
        If bUpper = True Then
            nEdgeSourceR = 1
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 2
            nEdgeSourceC = nNodeC - 1
        End If
    Case "d"
        If bUpper = True Then
            nEdgeSourceR = 3
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 4
            nEdgeSourceC = nNodeC - 1
        End If
    End Select
    
    GetPosOfSourceT7B5C = True
    
End Function

Function DigitsToSheetRowC(ByVal sIn As String, ByVal nNumGrp As Long, _
    ByVal nRow As Long, Optional ByVal sRLabel As String = "*")
    ' takes string of digits and an option code and distributes bits to worksheet rows
    
    Dim n As Long, c As Long, sSamp As String
    Dim oSht As Worksheet
    
    Set oSht = ThisWorkbook.Worksheets("Sheet1")
    oSht.Activate
    
    If Len(sIn) Mod nNumGrp <> 0 Then
        MsgBox "Missing bits for grouping in  DigitsToSheetRow - closing"
        Exit Function
    End If
    
    c = 0
    ' 101 010 101 010
    For n = 1 To (Len(sIn) - nNumGrp + 1) Step nNumGrp
        DoEvents
        sSamp = Mid$(sIn, n, nNumGrp)
        c = c + 1
        oSht.Cells(nRow, c + 1) = sSamp
        If c >= 16384 Then Exit For
    Next n
    oSht.Cells(nRow, 1) = sRLabel
    
End Function

Sub ColourTheErrors(ByVal nLen As Long)
    ' colors specific data to show errors
    ' changes to decoder pairs in magenta
    ' changes between input and output message in red
    ' marks individual received bit errors in bold yellow
    ' marking is limited to 256 columns to accommodate Excel 2003

    Dim oSht As Worksheet, c As Long, nRow As Long

    Set oSht = ThisWorkbook.Worksheets("Sheet1")
    oSht.Activate
    With oSht.Cells
       .Font.Color = RGB(0, 0, 0)
       .Font.Bold = False
    End With

    'clear colours in rows below first four to preserve backpath
    For nRow = 5 To 20
       oSht.Rows(nRow).Cells.Interior.Pattern = xlNone
    Next nRow

    For c = 2 To nLen + 1 'this is specified length of the string for display
        'Note that Excel versions have different max columns
        'Up to user to get it right eg: max 256 for Excel 2003
        'block with error colouring
        'message errors are in red
        If oSht.Cells(10, c) <> oSht.Cells(6, c) Then oSht.Cells(10, c).Interior.Color = vbRed
        'received channel errors magenta
        If oSht.Cells(7, c) <> oSht.Cells(8, c) Then oSht.Cells(8, c).Interior.Color = vbMagenta

        'individual errored character colouring in yellow within magenta block
        If Left(oSht.Cells(8, c).Value, 1) <> Left(oSht.Cells(7, c).Value, 1) Then
           With oSht.Cells(8, c).Characters(1, 1).Font
              .Color = -16711681
              .Bold = True
           End With
        End If

        If Right(oSht.Cells(8, c).Value, 1) <> Right(oSht.Cells(7, c).Value, 1) Then
          With oSht.Cells(8, c).Characters(2, 1).Font
             .Color = -16711681
             .Bold = True
          End With
        End If
    Next c

End Sub

Function GetOutputBitsT7B6C(sState As String, bUpper As Boolean, _
    sEdgeBits As String, sInputBit As String) As Boolean
    ' returns edge value and input given the alpha state name
    ' and choice of top or bottom branch.
    ' Applies to incoming branches joining at the node.
    
    Select Case sState
    Case "a"
        If bUpper = True Then
            sEdgeBits = "00"
            sInputBit = "0"
        Else
            sEdgeBits = "10"
            sInputBit = "0"
        End If
    Case "b"
        If bUpper = True Then
            sEdgeBits = "11"
            sInputBit = "0"
        Else
            sEdgeBits = "01"
            sInputBit = "0"
        End If
    Case "c"
        If bUpper = True Then
            sEdgeBits = "11"
            sInputBit = "1"
        Else
            sEdgeBits = "01"
            sInputBit = "1"
        End If
    Case "d"
        If bUpper = True Then
            sEdgeBits = "00"
            sInputBit = "1"
        Else
            sEdgeBits = "10"
            sInputBit = "1"
        End If
    End Select
    
    GetOutputBitsT7B6C = True
    
End Function

Function GetPosOfSourceT7B6C(nNodeR As Long, nNodeC As Long, bUpper As Boolean, _
    nEdgeSourceR As Long, nEdgeSourceC As Long) As Boolean
    ' returns the array column and row for an incoming branch,
    ' given its position in trellis column and choice of top or bottom branch.
    
    Dim sNodesState As String
    
    ' convert to string state names
    Select Case nNodeR
    Case 1
        sNodesState = "a"
    Case 2
        sNodesState = "b"
    Case 3
        sNodesState = "c"
    Case 4
        sNodesState = "d"
    End Select
    
    ' for c=0 only
    If nNodeC = 0 Then
        MsgBox "No source beyond zero column"
        Exit Function
    End If
    
    ' For c>0 only
    Select Case sNodesState
    Case "a"
        If bUpper = True Then
            nEdgeSourceR = 1
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 2
            nEdgeSourceC = nNodeC - 1
        End If
    Case "b"
        If bUpper = True Then
            nEdgeSourceR = 3
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 4
            nEdgeSourceC = nNodeC - 1
        End If
    Case "c"
        If bUpper = True Then
            nEdgeSourceR = 1
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 2
            nEdgeSourceC = nNodeC - 1
        End If
    Case "d"
        If bUpper = True Then
            nEdgeSourceR = 3
            nEdgeSourceC = nNodeC - 1
        Else
            nEdgeSourceR = 4
            nEdgeSourceC = nNodeC - 1
        End If
    End Select
    
    GetPosOfSourceT7B6C = True
    
End Function

Function AutoRandomInputC(ByVal nLength As Long) As String
    ' makes a pseudo random string of parameter nLength
    
    Dim n As Long, sSamp As String, sAccum As String
    
    ' Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    
    Randomize Timer
    For n = 1 To (nLength)
        sSamp = CStr(Int((1 - 0 + 1) * Rnd + 0))
        sAccum = sAccum & sSamp
    Next n
    
    AutoRandomInputC = sAccum
    
End Function

Function NumBitsDifferentC(ByVal sIn1 As String, ByVal sIn2 As String, Optional nLength As Long) As Long
    ' compares two binary strings of equal length
    ' and returns the count of the bits in function name that are different
    ' It is the Hamming distance between the two bit strings
    
    Dim nErr As Long, n As Long, m As Long
    
    ' check that streams are same length for comparison
    If Len(sIn1) <> Len(sIn2) Then
        MsgBox "Stream lengths do not match in StrDifference - closing"
        Exit Function
    End If
    
    ' 0 and  0 =   0
    ' 0 and  1 =   1
    ' 1 and  0 =   1
    ' 1 and  1 =   0
    
    For n = 1 To Len(sIn1)
        nErr = Abs(CLng(Mid$(sIn1, n, 1)) - CLng(Mid$(sIn2, n, 1)))
        m = m + nErr
    Next n
    
Transfers:
    nLength = Len(sIn1)
    NumBitsDifferentC = m
    
End Function