Function DigitalRoot(n As Integer) As Integer
    While n > 9
        Dim s As String = Str(n)
        n = 0
        For i As Integer = 1 To Len(s)
            n += Val(Mid(s, i, 1))
        Next
    Wend
    Return n
End Function

Sub BubbleSort(arr() As String)
    For i As Integer = 1 To Ubound(arr) - 1
        For j As Integer = 1 To Ubound(arr) - i - 1
            If arr(j) > arr(j + 1) Then Swap arr(j), arr(j + 1)
        Next
    Next
End Sub

Sub ReadLines(filename As String, lines() As String)
    Open filename For Input As #1
    Dim linea As String
    Dim lineCount As Integer = 0
    Do While Not Eof(1)
        Line Input #1, linea
        lineCount += 1
        Redim Preserve lines(lineCount)
        lines(lineCount - 1) = linea
    Loop
    Close #1
End Sub

Sub FilterWords(lines() As String, words() As String)
    Dim As Integer i, j
    Dim wordCount As Integer = 0
    For i = 0 To Ubound(lines)
        Dim w As String = Trim(lines(i))
        If Len(w) >= 4 Then
            Dim valid As Boolean = True
            For j = 1 To Len(w)
                If Instr("abcdef", Mid(w, j, 1)) = 0 Then
                    valid = False
                    Exit For
                End If
            Next
            If valid Then
                wordCount += 1
                Redim Preserve words(wordCount)
                words(wordCount - 1) = w
            End If
        End If
    Next
End Sub

Sub CalculateResults(words() As String, results() As String)
    Dim resultCount As Integer = 0
    For i As Integer = 0 To Ubound(words)-1
        Dim w As String = words(i)
        Dim base10 As Integer = Val("&H" & w)
        Dim root As Integer = DigitalRoot(base10)
        resultCount += 1
        Redim Preserve results(resultCount)
        results(resultCount - 1) = Str(root) & " " & w & " " & Str(base10)
    Next
End Sub

Sub PrintResults(results() As String, title As String)
    Dim As Integer i, j
    Print title
    Print "Root  Word      Base 10"
    Print String(23, "-")
    BubbleSort(results())
    For i = 0 To Ubound(results) -1
        Dim parts() As String
        Dim part As String = ""
        Dim partIndex As Integer = 0
        For j = 1 To Len(results(i))
            If Mid(results(i), j, 1) = " " Then
                partIndex += 1
                Redim Preserve parts(partIndex)
                parts(partIndex - 1) = part
                part = ""
            Else
                part &= Mid(results(i), j, 1)
            End If
        Next
        partIndex += 1
        Redim Preserve parts(partIndex)
        parts(partIndex - 1) = part

        Print Using "##    \    \   ########"; Val(parts(0)); parts(1); Val(parts(2))
    Next
    Print "Total count of these words: "; Ubound(results)
End Sub

Sub FilterDistinctLetters(results() As String, filteredResults() As String)
    Dim As Integer i, j
    Dim filteredCount As Integer = 0
    For i = 0 To Ubound(results)
        Dim parts() As String
        Dim part As String = ""
        Dim partIndex As Integer = 0
        For j = 1 To Len(results(i))
            If Mid(results(i), j, 1) = " " Then
                partIndex += 1
                Redim Preserve parts(partIndex)
                parts(partIndex - 1) = part
                part = ""
            Else
                part &= Mid(results(i), j, 1)
            End If
        Next
        partIndex += 1
        Redim Preserve parts(partIndex)
        parts(partIndex - 1) = part

        Dim w As String = parts(1)
        If Len(w) > 3 Then
            Dim distinct As String = ""
            For j = 1 To Len(w)
                If Instr(distinct, Mid(w, j, 1)) = 0 Then
                    distinct &= Mid(w, j, 1)
                End If
            Next
            If Len(distinct) > 3 Then
                filteredCount += 1
                Redim Preserve filteredResults(filteredCount)
                filteredResults(filteredCount - 1) = results(i)
            End If
        End If
    Next
End Sub

Dim lines() As String
Dim words() As String
Dim results() As String
Dim filteredResults() As String

' Main program
ReadLines("unixdict.txt", lines())
FilterWords(lines(), words())
CalculateResults(words(), results())

PrintResults(results(), "Hex words in unixdict.txt:")
Print

FilterDistinctLetters(results(), filteredResults())
PrintResults(filteredResults(), "Hex words with > 3 distinct letters:")

Sleep